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