;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (gnu system install)
#:use-module (gnu)
+ #:use-module (gnu bootloader u-boot)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module ((guix store) #:select (%store-prefix))
- #:use-module (guix profiles)
#:use-module (gnu services shepherd)
+ #:use-module (gnu services ssh)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages guile)
#:use-module (gnu packages linux)
+ #:use-module (gnu packages ssh)
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages package-management)
#:use-module (gnu packages disk)
- #:use-module (gnu packages grub)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages compression)
+ #:use-module (gnu packages nvi)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
- #:export (self-contained-tarball
- installation-os))
+ #:export (installation-os
+ a20-olinuxino-lime2-emmc-installation-os
+ a20-olinuxino-micro-installation-os
+ banana-pi-m2-ultra-installation-os
+ beaglebone-black-installation-os
+ nintendo-nes-classic-edition-installation-os))
;;; Commentary:
;;;
;;; Code:
\f
-(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"))
-
- ;; Note: there is not much to gain here with deduplication and there
- ;; is the overhead of the '.links' directory, so turn it off.
- (populate-single-profile-directory %root
- #:profile #$profile
- #:closure "profile"
- #:deduplicate? #f)
-
- ;; Create the tarball. Use GNU format so there's no file name
- ;; length limitation.
- (with-directory-excursion %root
- (zero? (system* "tar" "--xz" "--format=gnu"
-
- ;; Avoid non-determinism in the archive. Use
- ;; mtime = 1, not zero, because that is what the
- ;; daemon does for files in the store (see the
- ;; 'mtimeStore' constant in local-store.cc.)
- "--sort=name"
- "--mtime=@1" ;for files in /var/guix
- "--owner=root:0"
- "--group=root:0"
-
- "--check-links"
- "-cvf" #$output
- ;; Avoid adding / and /var to the tarball,
- ;; so that the ownership and permissions of those
- ;; directories will not be overwritten when
- ;; extracting the archive. Do not include /root
- ;; because the root account might have a different
- ;; home directory.
- "./var/guix"
- (string-append "." (%store-directory)))))))
-
- (gexp->derivation "guix-tarball.tar.xz" build
- #:references-graphs `(("profile" ,profile))
- #:modules '((guix build utils)
- (guix build store-copy)
- (gnu build install)))))
-
-\f
(define (log-to-info)
"Return a script that spawns the Info reader on the right section of the
manual."
"Return a gexp that makes the store copy-on-write, using TARGET as the
backing store. This is useful when TARGET is on a hard disk, whereas the
current store is on a RAM disk."
- (define (unionfs read-only read-write mount-point)
- ;; Make MOUNT-POINT the union of READ-ONLY and READ-WRITE.
-
- ;; Note: in the command below, READ-WRITE appears before READ-ONLY so that
- ;; it is considered a "higher-level branch", as per unionfs-fuse(8),
- ;; thereby allowing files existing on READ-ONLY to be copied over to
- ;; READ-WRITE.
- #~(fork+exec-command
- (list (string-append #$unionfs-fuse "/bin/unionfs")
- "-o"
- "cow,allow_other,use_ino,max_files=65536,nonempty"
- (string-append #$read-write "=RW:" #$read-only "=RO")
- #$mount-point)))
(define (set-store-permissions directory)
;; Set the right perms on DIRECTORY to use it as the store.
(chmod #$directory #o1775)))
#~(begin
- (unless (file-exists? "/.ro-store")
- (mkdir "/.ro-store")
- (mount #$(%store-prefix) "/.ro-store" "none"
- (logior MS_BIND MS_RDONLY)))
+ ;; Bind-mount TARGET's /tmp in case we need space to build things.
+ (let ((tmpdir (string-append #$target "/tmp")))
+ (mkdir-p tmpdir)
+ (mount tmpdir "/tmp" "none" MS_BIND))
- (let ((rw-dir (string-append target #$%backing-directory)))
+ (let* ((rw-dir (string-append target #$%backing-directory))
+ (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
(mkdir-p rw-dir)
+ (mkdir-p work-dir)
(mkdir-p "/.rw-store")
#$(set-store-permissions #~rw-dir)
#$(set-store-permissions "/.rw-store")
- ;; Mount the union, then atomically make it the store.
- (and #$(unionfs "/.ro-store" #~rw-dir "/.rw-store")
- (begin
- (sleep 1) ;XXX: wait for unionfs to be ready
- (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
- (rmdir "/.rw-store"))))))
+ ;; Mount the overlay, then atomically make it the store.
+ (mount "none" "/.rw-store" "overlay" 0
+ (string-append "lowerdir=" #$(%store-prefix) ","
+ "upperdir=" rw-dir ","
+ "workdir=" work-dir))
+ (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
+ (rmdir "/.rw-store"))))
(define cow-store-service-type
(shepherd-service-type
"Return a list of tuples representing configuration templates to add to
/etc."
(define (file f)
- (local-file (search-path %load-path
- (string-append "gnu/system/examples/" f))))
+ (local-file (string-append "examples/" f)))
(define directory
(computed-file "configuration-templates"
- #~(begin
- (mkdir #$output)
- (for-each (lambda (file target)
- (copy-file file
- (string-append #$output "/"
- target)))
- '(#$(file "bare-bones.tmpl")
- #$(file "desktop.tmpl")
- #$(file "lightweight-desktop.tmpl"))
- '("bare-bones.scm"
- "desktop.scm"
- "lightweight-desktop.scm"))
- #t)
- #:modules '((guix build utils))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (mkdir #$output)
+ (for-each (lambda (file target)
+ (copy-file file
+ (string-append #$output "/"
+ target)))
+ '(#$(file "bare-bones.tmpl")
+ #$(file "beaglebone-black.tmpl")
+ #$(file "desktop.tmpl")
+ #$(file "lightweight-desktop.tmpl"))
+ '("bare-bones.scm"
+ "beaglebone-black.scm"
+ "desktop.scm"
+ "lightweight-desktop.scm"))
+ #t))))
`(("configuration" ,directory)))
(persistent? #f)
(max-database-size (* 5 (expt 2 20)))))) ;5 MiB
-(define (installation-services)
- "Return the list services for the installation image."
+(define %installation-services
+ ;; List of services of the installation system.
(let ((motd (plain-file "motd" "
-Welcome to the installation of the Guix System Distribution!
+\x1b[1;37mWelcome to the installation of the Guix System Distribution!\x1b[0m
-There is NO WARRANTY, to the extent permitted by law. In particular, you may
+\x1b[2mThere is NO WARRANTY, to the extent permitted by law. In particular, you may
LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
it is 'beta' software, so it may contain bugs.
-You have been warned. Thanks for being so brave.
+You have been warned. Thanks for being so brave.\x1b[0m
")))
(define (normal-tty tty)
(mingetty-service (mingetty-configuration (tty tty)
- (motd motd)
(auto-login "root")
(login-pause? #t))))
+ (define bare-bones-os
+ (load "examples/bare-bones.tmpl"))
+
(list (mingetty-service (mingetty-configuration
(tty "tty1")
- (motd motd)
(auto-login "root")))
+ (login-service (login-configuration
+ (motd motd)))
+
;; Documentation. The manual is in UTF-8, but
;; 'console-font-service' sets up Unicode support and loads a font
;; with all the useful glyphs like em dash and quotation marks.
(mingetty-service (mingetty-configuration
(tty "tty2")
- (motd motd)
(auto-login "guest")
(login-program (log-to-info))))
;; since it takes the installation directory as an argument.
(cow-store-service)
- ;; Install Unicode support and a suitable font.
- (console-font-service "tty1")
- (console-font-service "tty2")
- (console-font-service "tty3")
- (console-font-service "tty4")
- (console-font-service "tty5")
- (console-font-service "tty6")
+ ;; Install Unicode support and a suitable font. Use a font that
+ ;; doesn't have more than 256 glyphs so that we can use colors with
+ ;; varying brightness levels (see note in setfont(8)).
+ (service console-font-service-type
+ (map (lambda (tty)
+ (cons tty "lat9u-16"))
+ '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
;; To facilitate copy/paste.
(gpm-service)
- ;; Since this is running on a USB stick with a unionfs as the root
+ ;; Add an SSH server to facilitate remote installs.
+ (service openssh-service-type
+ (openssh-configuration
+ (port-number 22)
+ (permit-root-login #t)
+ ;; The root account is passwordless, so make sure
+ ;; a password is set before allowing logins.
+ (allow-empty-passwords? #f)
+ (password-authentication? #t)
+
+ ;; Don't start it upfront.
+ (%auto-start? #f)))
+
+ ;; Since this is running on a USB stick with a overlayfs as the root
;; file system, use an appropriate cache configuration.
(nscd-service (nscd-configuration
- (caches %nscd-minimal-caches))))))
+ (caches %nscd-minimal-caches)))
+
+ ;; Having /bin/sh is a good idea. In particular it allows Tramp
+ ;; connections to this system to work.
+ (service special-files-service-type
+ `(("/bin/sh" ,(file-append (canonical-package bash)
+ "/bin/sh"))))
+
+ ;; Keep a reference to BARE-BONES-OS to make sure it can be
+ ;; installed without downloading/building anything. Also keep the
+ ;; things needed by 'profile-derivation' to minimize the amount of
+ ;; download.
+ (service gc-root-service-type
+ (list bare-bones-os
+ glibc-utf8-locales
+ texinfo
+ (canonical-package guile-2.2))))))
(define %issue
;; Greeting.
"
-This is an installation image of the GNU system. Welcome.
+\x1b[1;37mThis is an installation image of the GNU system. Welcome.\x1b[0m
-Use Alt-F2 for documentation.
+\x1b[1;33mUse Alt-F2 for documentation.\x1b[0m
")
(define installation-os
(host-name "gnu")
(timezone "Europe/Paris")
(locale "en_US.utf8")
- (bootloader (grub-configuration
- (device "/dev/sda")))
+ (bootloader (bootloader-configuration
+ (bootloader grub-bootloader)
+ (target "/dev/sda")))
(file-systems
;; Note: the disk image build code overrides this root file system with
;; the appropriate one.
(cons* (file-system
(mount-point "/")
- (device "gnu-disk-image")
+ (device "GuixSD_image")
(title 'label)
(type "ext4"))
- ;; Make /tmp a tmpfs instead of keeping the unionfs. This is
- ;; because FUSE creates '.fuse_hiddenXYZ' files for each open file,
- ;; and this confuses Guix's test suite, for instance. See
- ;; <http://bugs.gnu.org/23056>.
+ ;; Make /tmp a tmpfs instead of keeping the overlayfs. This
+ ;; originally was used for unionfs because FUSE creates
+ ;; '.fuse_hiddenXYZ' files for each open file, and this confuses
+ ;; Guix's test suite, for instance (see
+ ;; <http://bugs.gnu.org/23056>). We keep this for overlayfs to be
+ ;; on the safe side.
(file-system
(mount-point "/tmp")
(device "none")
(home-directory "/home/guest"))))
(issue %issue)
+ (services %installation-services)
- (services (installation-services))
-
- ;; We don't need setuid programs so pass the empty list so we don't pull
- ;; additional programs here.
- (setuid-programs '())
+ ;; We don't need setuid programs, except for 'passwd', which can be handy
+ ;; if one is to allow remote SSH login to the machine being installed.
+ (setuid-programs (list (file-append shadow "/bin/passwd")))
(pam-services
;; Explicitly allow for empty passwords.
(base-pam-services #:allow-empty-passwords? #t))
(packages (cons* (canonical-package glibc) ;for 'tzselect' & co.
- parted ddrescue
+ parted gptfdisk ddrescue
grub ;mostly so xrefs to its manual work
cryptsetup
+ mdadm
+ dosfstools ;mkfs.fat, for the UEFI boot partition
btrfs-progs
+ openssh ;we already have sshd, having ssh/scp can help
wireless-tools iw wpa-supplicant-minimal iproute
;; XXX: We used to have GNU fdisk here, but as of version
;; 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
+ nvi ;:wq!
%base-packages))))
-;; Return it here so 'guix system' can consume it directly.
+(define* (agetty-default-service #:optional (tty "ttyS0"))
+ "Return an agetty-service on the given TTY"
+ (agetty-service (agetty-configuration
+ (extra-options '("-L"))
+ (baud-rate "115200")
+ (term "vt100")
+ (tty tty))))
+
+(define* (embedded-installation-os bootloader bootloader-target tty
+ #:key (extra-modules '()))
+ "Return an installation os for embedded systems.
+The initrd gets the extra modules EXTRA-MODULES.
+A getty is provided on TTY.
+The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
+ (operating-system
+ (inherit installation-os)
+ (bootloader (bootloader-configuration
+ (bootloader bootloader)
+ (target bootloader-target)))
+ (kernel linux-libre)
+ (initrd (lambda (fs . rest)
+ (apply base-initrd fs
+ #:extra-modules extra-modules
+ rest)))
+ (services (cons* (agetty-default-service tty)
+ (operating-system-user-services installation-os)))))
+
+(define beaglebone-black-installation-os
+ (embedded-installation-os u-boot-beaglebone-black-bootloader
+ "/dev/sda"
+ "ttyO0"
+ #:extra-modules
+ ;; This module is required to mount the sd card.
+ '("omap_hsmmc")))
+
+
+(define a20-olinuxino-lime2-emmc-installation-os
+ (embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
+ "/dev/mmcblk1" ; eMMC storage
+ "ttyS0"))
+
+(define a20-olinuxino-micro-installation-os
+ (embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
+ "/dev/mmcblk0" ; SD card storage
+ "ttyS0"))
+
+(define banana-pi-m2-ultra-installation-os
+ (embedded-installation-os u-boot-banana-pi-m2-ultra-bootloader
+ "/dev/mmcblk1" ; eMMC storage
+ "ttyS0"))
+
+(define nintendo-nes-classic-edition-installation-os
+ (embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
+ "/dev/mmcblk0" ; SD card (solder it yourself)
+ "ttyS0"))
+
+;; Return the default os here so 'guix system' can consume it directly.
installation-os
;;; install.scm ends here
HCoop / jackhill / guix / guix.git / blobdiff