gnu/system/install.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu system install)
  20   #:use-module (gnu)
  21   #:use-module (guix gexp)
  22   #:use-module (guix monads)
  23   #:use-module ((guix store) #:select (%store-prefix))
  24   #:use-module (gnu packages linux)
  25   #:use-module (gnu packages cryptsetup)
  26   #:use-module (gnu packages package-management)
  27   #:use-module (gnu packages disk)
  28   #:use-module (gnu packages grub)
  29   #:use-module (gnu packages texinfo)
  30   #:export (installation-os))
  31
  32 ;;; Commentary:
  33 ;;;
  34 ;;; This module provides an 'operating-system' definition for use on images
  35 ;;; for USB sticks etc., for the installation of the GNU system.
  36 ;;;
  37 ;;; Code:
  38
  39 (define (log-to-info)
  40   "Return a script that spawns the Info reader on the right section of the
  41 manual."
  42   (gexp->script "log-to-info"
  43                 #~(execl (string-append #$texinfo-4 "/bin/info") "info"
  44                          "-d" "/run/current-system/profile/share/info"
  45                          "-f" (string-append #$guix "/share/info/guix.info")
  46                          "-n" "System Installation")))
  47
  48 (define %backing-directory
  49   ;; Sub-directory used as the backing store for copy-on-write.
  50   "/tmp/guix-inst")
  51
  52 (define (make-cow-store target)
  53   "Return a gexp that makes the store copy-on-write, using TARGET as the
  54 backing store.  This is useful when TARGET is on a hard disk, whereas the
  55 current store is on a RAM disk."
  56   (define (unionfs read-only read-write mount-point)
  57     ;; Make MOUNT-POINT the union of READ-ONLY and READ-WRITE.
  58
  59     ;; Note: in the command below, READ-WRITE appears before READ-ONLY so that
  60     ;; it is considered a "higher-level branch", as per unionfs-fuse(8),
  61     ;; thereby allowing files existing on READ-ONLY to be copied over to
  62     ;; READ-WRITE.
  63     #~(fork+exec-command
  64        (list (string-append #$unionfs-fuse "/bin/unionfs")
  65              "-o"
  66              "cow,allow_other,use_ino,max_files=65536,nonempty"
  67              (string-append #$read-write "=RW:" #$read-only "=RO")
  68              #$mount-point)))
  69
  70   (define (set-store-permissions directory)
  71     ;; Set the right perms on DIRECTORY to use it as the store.
  72     #~(begin
  73         (chown #$directory 0 30000)             ;use the fixed 'guixbuild' GID
  74         (chmod #$directory #o1775)))
  75
  76   #~(begin
  77       (unless (file-exists? "/.ro-store")
  78         (mkdir "/.ro-store")
  79         (mount #$(%store-prefix) "/.ro-store" "none"
  80                (logior MS_BIND MS_RDONLY)))
  81
  82       (let ((rw-dir (string-append target #$%backing-directory)))
  83         (mkdir-p rw-dir)
  84         (mkdir-p "/.rw-store")
  85         #$(set-store-permissions #~rw-dir)
  86         #$(set-store-permissions "/.rw-store")
  87
  88         ;; Mount the union, then atomically make it the store.
  89         (and #$(unionfs "/.ro-store" #~rw-dir "/.rw-store")
  90              (begin
  91                (sleep 1) ;XXX: wait for unionfs to be ready
  92                (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
  93                (rmdir "/.rw-store"))))))
  94
  95 (define (cow-store-service)
  96   "Return a service that makes the store copy-on-write, such that writes go to
  97 the user's target storage device rather than on the RAM disk."
  98   ;; See <http://bugs.gnu.org/18061> for the initial report.
  99   (with-monad %store-monad
 100     (return (service
 101              (requirement '(root-file-system user-processes))
 102              (provision '(cow-store))
 103              (documentation
 104               "Make the store copy-on-write, with writes going to \
 105 the given target.")
 106
 107              ;; This is meant to be explicitly started by the user.
 108              (auto-start? #f)
 109
 110              (start #~(case-lambda
 111                         ((target)
 112                          #$(make-cow-store #~target)
 113                          target)
 114                         (else
 115                          ;; Do nothing, and mark the service as stopped.
 116                          #f)))
 117              (stop #~(lambda (target)
 118                        ;; Delete the temporary directory, but leave everything
 119                        ;; mounted as there may still be processes using it
 120                        ;; since 'user-processes' doesn't depend on us.  The
 121                        ;; 'user-unmount' service will unmount TARGET
 122                        ;; eventually.
 123                        (delete-file-recursively
 124                         (string-append target #$%backing-directory))))))))
 125
 126 (define (configuration-template-service)
 127   "Return a dummy service whose purpose is to install an operating system
 128 configuration template file in the installation system."
 129
 130   (define local-template
 131     "/etc/configuration-template.scm")
 132   (define template
 133     (search-path %load-path "gnu/system/os-config.tmpl"))
 134
 135   (mlet %store-monad ((template (interned-file template)))
 136     (return (service
 137              (requirement '(root-file-system))
 138              (provision '(os-config-template))
 139              (documentation
 140               "This dummy service installs an OS configuration template.")
 141              (start #~(const #t))
 142              (stop  #~(const #f))
 143              (activate
 144               #~(unless (file-exists? #$local-template)
 145                   (copy-file #$template #$local-template)))))))
 146
 147 (define (installation-services)
 148   "Return the list services for the installation image."
 149   (let ((motd (text-file "motd" "
 150 Welcome to the installation of the GNU operating system!
 151
 152 There is NO WARRANTY, to the extent permitted by law.  In particular, you may
 153 LOSE ALL YOUR DATA as a side effect of the installation process.  Furthermore,
 154 it is alpha software, so it may BREAK IN UNEXPECTED WAYS.
 155
 156 You have been warned.  Thanks for being so brave.
 157 ")))
 158     (define (normal-tty tty)
 159       (mingetty-service tty
 160                         #:motd motd
 161                         #:auto-login "root"
 162                         #:login-pause? #t))
 163
 164     (list (mingetty-service "tty1"
 165                             #:motd motd
 166                             #:auto-login "root")
 167
 168           ;; Documentation.  The manual is in UTF-8, but
 169           ;; 'console-font-service' sets up Unicode support and loads a font
 170           ;; with all the useful glyphs like em dash and quotation marks.
 171           (mingetty-service "tty2"
 172                             #:motd motd
 173                             #:auto-login "guest"
 174                             #:login-program (log-to-info))
 175
 176           ;; Documentation add-on.
 177           (configuration-template-service)
 178
 179           ;; A bunch of 'root' ttys.
 180           (normal-tty "tty3")
 181           (normal-tty "tty4")
 182           (normal-tty "tty5")
 183           (normal-tty "tty6")
 184
 185           ;; The usual services.
 186           (syslog-service)
 187
 188           ;; The build daemon.  Register the hydra.gnu.org key as trusted.
 189           ;; This allows the installation process to use substitutes by
 190           ;; default.
 191           (guix-service #:authorize-hydra-key? #t)
 192
 193           ;; Start udev so that useful device nodes are available.
 194           (udev-service)
 195
 196           ;; Add the 'cow-store' service, which users have to start manually
 197           ;; since it takes the installation directory as an argument.
 198           (cow-store-service)
 199
 200           ;; Install Unicode support and a suitable font.
 201           (console-font-service "tty1")
 202           (console-font-service "tty2")
 203           (console-font-service "tty3")
 204           (console-font-service "tty4")
 205           (console-font-service "tty5")
 206           (console-font-service "tty6")
 207
 208           (nscd-service))))
 209
 210 (define %issue
 211   ;; Greeting.
 212   "
 213 This is an installation image of the GNU system.  Welcome.
 214
 215 Use Alt-F2 for documentation.
 216 ")
 217
 218 (define installation-os
 219   ;; The operating system used on installation images for USB sticks etc.
 220   (operating-system
 221     (host-name "gnu")
 222     (timezone "Europe/Paris")
 223     (locale "en_US.UTF-8")
 224     (bootloader (grub-configuration
 225                  (device "/dev/sda")))
 226     (file-systems
 227      ;; Note: the disk image build code overrides this root file system with
 228      ;; the appropriate one.
 229      (cons (file-system
 230              (mount-point "/")
 231              (device "gnu-disk-image")
 232              (type "ext4"))
 233            %base-file-systems))
 234
 235     (users (list (user-account
 236                   (name "guest")
 237                   (group "users")
 238                   (supplementary-groups '("wheel"))  ; allow use of sudo
 239                   (password "")
 240                   (comment "Guest of GNU")
 241                   (home-directory "/home/guest"))))
 242
 243     (issue %issue)
 244
 245     (services (installation-services))
 246
 247     ;; We don't need setuid programs so pass the empty list so we don't pull
 248     ;; additional programs here.
 249     (setuid-programs '())
 250
 251     (pam-services
 252      ;; Explicitly allow for empty passwords.
 253      (base-pam-services #:allow-empty-passwords? #t))
 254
 255     (packages (cons* texinfo-4                 ;for the standalone Info reader
 256                      parted ddrescue
 257                      grub                  ;mostly so xrefs to its manual work
 258                      cryptsetup
 259                      wireless-tools
 260                      ;; XXX: We used to have GNU fdisk here, but as of version
 261                      ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
 262                      ;; space; furthermore util-linux's fdisk is already
 263                      ;; available here, so we keep that.
 264                      %base-packages))))
 265
 266 ;; Return it here so 'guix system' can consume it directly.
 267 installation-os
 268
 269 ;;; install.scm ends here