;;; 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 (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 nvi)
#:use-module (ice-9 match)
#:use-module (srfi srfi-26)
- #:export (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:
;;;
"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.
(mkdir-p tmpdir)
(mount tmpdir "/tmp" "none" MS_BIND))
- (unless (file-exists? "/.ro-store")
- (mkdir "/.ro-store")
- (mount #$(%store-prefix) "/.ro-store" "none"
- (logior MS_BIND MS_RDONLY)))
-
- (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
(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))))
(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)
(auto-login "root")
(login-pause? #t))))
+ (define bare-bones-os
+ (load "examples/bare-bones.tmpl"))
+
(list (mingetty-service (mingetty-configuration
(tty "tty1")
(auto-login "root")))
;; since it takes the installation directory as an argument.
(cow-store-service)
- ;; Install Unicode support and a suitable font.
+ ;; 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 %default-console-font))
+ (cons tty "lat9u-16"))
'("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
;; To facilitate copy/paste.
;; The root account is passwordless, so make sure
;; a password is set before allowing logins.
(allow-empty-passwords? #f)
- (password-authentication? #t)))
+ (password-authentication? #t)
- ;; Since this is running on a USB stick with a unionfs as the root
+ ;; 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")
(issue %issue)
(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.
- shadow ;'passwd', for easy SSH access
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
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