gnu/system/install.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
   5 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu system install)
  23   #:use-module (gnu)
  24   #:use-module (guix gexp)
  25   #:use-module (guix store)
  26   #:use-module (guix monads)
  27   #:use-module ((guix store) #:select (%store-prefix))
  28   #:use-module (gnu services shepherd)
  29   #:use-module (gnu services ssh)
  30   #:use-module (gnu packages admin)
  31   #:use-module (gnu packages bash)
  32   #:use-module (gnu packages bootloaders)
  33   #:use-module (gnu packages linux)
  34   #:use-module (gnu packages ssh)
  35   #:use-module (gnu packages cryptsetup)
  36   #:use-module (gnu packages package-management)
  37   #:use-module (gnu packages disk)
  38   #:use-module (gnu packages texinfo)
  39   #:use-module (gnu packages compression)
  40   #:use-module (gnu packages nvi)
  41   #:use-module (ice-9 match)
  42   #:use-module (srfi srfi-26)
  43   #:export (installation-os))
  44
  45 ;;; Commentary:
  46 ;;;
  47 ;;; This module provides an 'operating-system' definition for use on images
  48 ;;; for USB sticks etc., for the installation of the GNU system.
  49 ;;;
  50 ;;; Code:
  51
  52 \f
  53 (define (log-to-info)
  54   "Return a script that spawns the Info reader on the right section of the
  55 manual."
  56   (program-file "log-to-info"
  57                 #~(begin
  58                     ;; 'gunzip' is needed to decompress the doc.
  59                     (setenv "PATH" (string-append #$gzip "/bin"))
  60
  61                     (execl (string-append #$info-reader "/bin/info") "info"
  62                            "-d" "/run/current-system/profile/share/info"
  63                            "-f" (string-append #$guix "/share/info/guix.info")
  64                            "-n" "System Installation"))))
  65
  66 (define %backing-directory
  67   ;; Sub-directory used as the backing store for copy-on-write.
  68   "/tmp/guix-inst")
  69
  70 (define (make-cow-store target)
  71   "Return a gexp that makes the store copy-on-write, using TARGET as the
  72 backing store.  This is useful when TARGET is on a hard disk, whereas the
  73 current store is on a RAM disk."
  74
  75   (define (set-store-permissions directory)
  76     ;; Set the right perms on DIRECTORY to use it as the store.
  77     #~(begin
  78         (chown #$directory 0 30000)             ;use the fixed 'guixbuild' GID
  79         (chmod #$directory #o1775)))
  80
  81   #~(begin
  82       ;; Bind-mount TARGET's /tmp in case we need space to build things.
  83       (let ((tmpdir (string-append #$target "/tmp")))
  84         (mkdir-p tmpdir)
  85         (mount tmpdir "/tmp" "none" MS_BIND))
  86
  87       (let* ((rw-dir (string-append target #$%backing-directory))
  88              (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
  89         (mkdir-p rw-dir)
  90         (mkdir-p work-dir)
  91         (mkdir-p "/.rw-store")
  92         #$(set-store-permissions #~rw-dir)
  93         #$(set-store-permissions "/.rw-store")
  94
  95         ;; Mount the overlay, then atomically make it the store.
  96         (mount "none" "/.rw-store" "overlay" 0
  97                (string-append "lowerdir=" #$(%store-prefix) ","
  98                               "upperdir=" rw-dir ","
  99                               "workdir=" work-dir))
 100         (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
 101         (rmdir "/.rw-store"))))
 102
 103 (define cow-store-service-type
 104   (shepherd-service-type
 105    'cow-store
 106    (lambda _
 107      (shepherd-service
 108       (requirement '(root-file-system user-processes))
 109       (provision '(cow-store))
 110       (documentation
 111        "Make the store copy-on-write, with writes going to \
 112 the given target.")
 113
 114       ;; This is meant to be explicitly started by the user.
 115       (auto-start? #f)
 116
 117       (start #~(case-lambda
 118                  ((target)
 119                   #$(make-cow-store #~target)
 120                   target)
 121                  (else
 122                   ;; Do nothing, and mark the service as stopped.
 123                   #f)))
 124       (stop #~(lambda (target)
 125                 ;; Delete the temporary directory, but leave everything
 126                 ;; mounted as there may still be processes using it since
 127                 ;; 'user-processes' doesn't depend on us.  The 'user-unmount'
 128                 ;; service will unmount TARGET eventually.
 129                 (delete-file-recursively
 130                  (string-append target #$%backing-directory))))))))
 131
 132 (define (cow-store-service)
 133   "Return a service that makes the store copy-on-write, such that writes go to
 134 the user's target storage device rather than on the RAM disk."
 135   ;; See <http://bugs.gnu.org/18061> for the initial report.
 136   (service cow-store-service-type 'mooooh!))
 137
 138
 139 (define (/etc/configuration-files _)
 140   "Return a list of tuples representing configuration templates to add to
 141 /etc."
 142   (define (file f)
 143     (local-file (string-append "examples/" f)))
 144
 145   (define directory
 146     (computed-file "configuration-templates"
 147                    (with-imported-modules '((guix build utils))
 148                      #~(begin
 149                          (mkdir #$output)
 150                          (for-each (lambda (file target)
 151                                      (copy-file file
 152                                                 (string-append #$output "/"
 153                                                                target)))
 154                                    '(#$(file "bare-bones.tmpl")
 155                                      #$(file "desktop.tmpl")
 156                                      #$(file "lightweight-desktop.tmpl"))
 157                                    '("bare-bones.scm"
 158                                      "desktop.scm"
 159                                      "lightweight-desktop.scm"))
 160                          #t))))
 161
 162   `(("configuration" ,directory)))
 163
 164 (define configuration-template-service-type
 165   (service-type (name 'configuration-template)
 166                 (extensions
 167                  (list (service-extension etc-service-type
 168                                           /etc/configuration-files)))))
 169
 170 (define %configuration-template-service
 171   (service configuration-template-service-type #t))
 172
 173
 174 (define %nscd-minimal-caches
 175   ;; Minimal in-memory caching policy for nscd.
 176   (list (nscd-cache (database 'hosts)
 177                     (positive-time-to-live (* 3600 12))
 178
 179                     ;; Do not cache lookup failures at all since they are
 180                     ;; quite likely (for instance when someone tries to ping a
 181                     ;; host before networking is functional.)
 182                     (negative-time-to-live 0)
 183
 184                     (persistent? #f)
 185                     (max-database-size (* 5 (expt 2 20)))))) ;5 MiB
 186
 187 (define %installation-services
 188   ;; List of services of the installation system.
 189   (let ((motd (plain-file "motd" "
 190 Welcome to the installation of the Guix System Distribution!
 191
 192 There is NO WARRANTY, to the extent permitted by law.  In particular, you may
 193 LOSE ALL YOUR DATA as a side effect of the installation process.  Furthermore,
 194 it is 'beta' software, so it may contain bugs.
 195
 196 You have been warned.  Thanks for being so brave.
 197 ")))
 198     (define (normal-tty tty)
 199       (mingetty-service (mingetty-configuration (tty tty)
 200                                                 (auto-login "root")
 201                                                 (login-pause? #t))))
 202
 203     (define bare-bones-os
 204       (load "examples/bare-bones.tmpl"))
 205
 206     (list (mingetty-service (mingetty-configuration
 207                              (tty "tty1")
 208                              (auto-login "root")))
 209
 210           (login-service (login-configuration
 211                           (motd motd)))
 212
 213           ;; Documentation.  The manual is in UTF-8, but
 214           ;; 'console-font-service' sets up Unicode support and loads a font
 215           ;; with all the useful glyphs like em dash and quotation marks.
 216           (mingetty-service (mingetty-configuration
 217                              (tty "tty2")
 218                              (auto-login "guest")
 219                              (login-program (log-to-info))))
 220
 221           ;; Documentation add-on.
 222           %configuration-template-service
 223
 224           ;; A bunch of 'root' ttys.
 225           (normal-tty "tty3")
 226           (normal-tty "tty4")
 227           (normal-tty "tty5")
 228           (normal-tty "tty6")
 229
 230           ;; The usual services.
 231           (syslog-service)
 232
 233           ;; The build daemon.  Register the hydra.gnu.org key as trusted.
 234           ;; This allows the installation process to use substitutes by
 235           ;; default.
 236           (guix-service (guix-configuration (authorize-key? #t)))
 237
 238           ;; Start udev so that useful device nodes are available.
 239           ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
 240           ;; regulations-compliant WiFi access.
 241           (udev-service #:rules (list lvm2 crda))
 242
 243           ;; Add the 'cow-store' service, which users have to start manually
 244           ;; since it takes the installation directory as an argument.
 245           (cow-store-service)
 246
 247           ;; Install Unicode support and a suitable font.
 248           (service console-font-service-type
 249                    (map (lambda (tty)
 250                           (cons tty %default-console-font))
 251                         '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 252
 253           ;; To facilitate copy/paste.
 254           (gpm-service)
 255
 256           ;; Add an SSH server to facilitate remote installs.
 257           (service openssh-service-type
 258                    (openssh-configuration
 259                     (port-number 22)
 260                     (permit-root-login #t)
 261                     ;; The root account is passwordless, so make sure
 262                     ;; a password is set before allowing logins.
 263                     (allow-empty-passwords? #f)
 264                     (password-authentication? #t)))
 265
 266           ;; Since this is running on a USB stick with a overlayfs as the root
 267           ;; file system, use an appropriate cache configuration.
 268           (nscd-service (nscd-configuration
 269                          (caches %nscd-minimal-caches)))
 270
 271           ;; Having /bin/sh is a good idea.  In particular it allows Tramp
 272           ;; connections to this system to work.
 273           (service special-files-service-type
 274                    `(("/bin/sh" ,(file-append (canonical-package bash)
 275                                               "/bin/sh"))))
 276
 277           ;; Keep a reference to BARE-BONES-OS to make sure it can be
 278           ;; installed without downloading/building anything.
 279           (service gc-root-service-type (list bare-bones-os)))))
 280
 281 (define %issue
 282   ;; Greeting.
 283   "
 284 This is an installation image of the GNU system.  Welcome.
 285
 286 Use Alt-F2 for documentation.
 287 ")
 288
 289 (define installation-os
 290   ;; The operating system used on installation images for USB sticks etc.
 291   (operating-system
 292     (host-name "gnu")
 293     (timezone "Europe/Paris")
 294     (locale "en_US.utf8")
 295     (bootloader (grub-configuration (target "/dev/sda")))
 296     (file-systems
 297      ;; Note: the disk image build code overrides this root file system with
 298      ;; the appropriate one.
 299      (cons* (file-system
 300               (mount-point "/")
 301               (device "GuixSD_image")
 302               (title 'label)
 303               (type "ext4"))
 304
 305             ;; Make /tmp a tmpfs instead of keeping the overlayfs.  This
 306             ;; originally was used for unionfs because FUSE creates
 307             ;; '.fuse_hiddenXYZ' files for each open file, and this confuses
 308             ;; Guix's test suite, for instance (see
 309             ;; <http://bugs.gnu.org/23056>).  We keep this for overlayfs to be
 310             ;; on the safe side.
 311             (file-system
 312               (mount-point "/tmp")
 313               (device "none")
 314               (title 'device)
 315               (type "tmpfs")
 316               (check? #f))
 317
 318             ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
 319             ;; elogind's cgroup file systems.
 320             (list %pseudo-terminal-file-system
 321                   %shared-memory-file-system
 322                   %immutable-store)))
 323
 324     (users (list (user-account
 325                   (name "guest")
 326                   (group "users")
 327                   (supplementary-groups '("wheel")) ; allow use of sudo
 328                   (password "")
 329                   (comment "Guest of GNU")
 330                   (home-directory "/home/guest"))))
 331
 332     (issue %issue)
 333     (services %installation-services)
 334
 335     ;; We don't need setuid programs, except for 'passwd', which can be handy
 336     ;; if one is to allow remote SSH login to the machine being installed.
 337     (setuid-programs (list (file-append shadow "/bin/passwd")))
 338
 339     (pam-services
 340      ;; Explicitly allow for empty passwords.
 341      (base-pam-services #:allow-empty-passwords? #t))
 342
 343     (packages (cons* (canonical-package glibc) ;for 'tzselect' & co.
 344                      parted gptfdisk ddrescue
 345                      grub                  ;mostly so xrefs to its manual work
 346                      cryptsetup
 347                      mdadm
 348                      dosfstools         ;mkfs.fat, for the UEFI boot partition
 349                      btrfs-progs
 350                      openssh    ;we already have sshd, having ssh/scp can help
 351                      wireless-tools iw wpa-supplicant-minimal iproute
 352                      ;; XXX: We used to have GNU fdisk here, but as of version
 353                      ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
 354                      ;; space; furthermore util-linux's fdisk is already
 355                      ;; available here, so we keep that.
 356                      bash-completion
 357                      nvi                          ;:wq!
 358                      %base-packages))))
 359
 360 ;; Return it here so 'guix system' can consume it directly.
 361 installation-os
 362
 363 ;;; install.scm ends here