[jackhill/guix/guix.git] / gnu / system / install.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu system install)
  #:use-module (gnu)
  #: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 packages admin)
  #:use-module (gnu packages linux)
  #: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)
  #:export (self-contained-tarball
            installation-os))

;;; Commentary:
;;;
;;; This module provides an 'operating-system' definition for use on images
;;; for USB sticks etc., for the installation of the GNU system.
;;;
;;; 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"))

          (populate-single-profile-directory %root
                                             #:profile #$profile
                                             #:closure "profile")

          ;; Create the tarball.  Use GNU format so there's no file name
          ;; length limitation.
          (with-directory-excursion %root
            (zero? (system* "tar" "--xz" "--format=gnu"
                            "-cvf" #$output ".")))))

    (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."
  (gexp->script "log-to-info"
                #~(begin
                    ;; 'gunzip' is needed to decompress the doc.
                    (setenv "PATH" (string-append #$gzip "/bin"))

                    (execl (string-append #$texinfo-4 "/bin/info") "info"
                           "-d" "/run/current-system/profile/share/info"
                           "-f" (string-append #$guix "/share/info/guix.info")
                           "-n" "System Installation"))))

(define %backing-directory
  ;; Sub-directory used as the backing store for copy-on-write.
  "/tmp/guix-inst")

(define (make-cow-store target)
  "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.
    #~(begin
        (chown #$directory 0 30000)             ;use the fixed 'guixbuild' GID
        (chmod #$directory #o1775)))

  #~(begin
      (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)))
        (mkdir-p rw-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"))))))

(define (cow-store-service)
  "Return a service that makes the store copy-on-write, such that writes go to
the user's target storage device rather than on the RAM disk."
  ;; See <http://bugs.gnu.org/18061> for the initial report.
  (with-monad %store-monad
    (return (service
             (requirement '(root-file-system user-processes))
             (provision '(cow-store))
             (documentation
              "Make the store copy-on-write, with writes going to \
the given target.")

             ;; This is meant to be explicitly started by the user.
             (auto-start? #f)

             (start #~(case-lambda
                        ((target)
                         #$(make-cow-store #~target)
                         target)
                        (else
                         ;; Do nothing, and mark the service as stopped.
                         #f)))
             (stop #~(lambda (target)
                       ;; Delete the temporary directory, but leave everything
                       ;; mounted as there may still be processes using it
                       ;; since 'user-processes' doesn't depend on us.  The
                       ;; 'user-unmount' service will unmount TARGET
                       ;; eventually.
                       (delete-file-recursively
                        (string-append target #$%backing-directory))))))))

(define (configuration-template-service)
  "Return a dummy service whose purpose is to install an operating system
configuration template file in the installation system."

  (define local-template
    "/etc/configuration-template.scm")
  (define template
    (search-path %load-path "gnu/system/os-config.tmpl"))

  (mlet %store-monad ((template (interned-file template)))
    (return (service
             (requirement '(root-file-system))
             (provision '(os-config-template))
             (documentation
              "This dummy service installs an OS configuration template.")
             (start #~(const #t))
             (stop  #~(const #f))
             (activate
              #~(unless (file-exists? #$local-template)
                  (copy-file #$template #$local-template)))))))

(define %nscd-minimal-caches
  ;; Minimal in-memory caching policy for nscd.
  (list (nscd-cache (database 'hosts)
                    (positive-time-to-live (* 3600 12))
                    (negative-time-to-live 20)
                    (persistent? #f)
                    (max-database-size (* 5 (expt 2 20)))))) ;5 MiB

(define (installation-services)
  "Return the list services for the installation image."
  (let ((motd (text-file "motd" "
Welcome to the installation of the Guix System Distribution!

There 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 alpha software, so it may BREAK IN UNEXPECTED WAYS.

You have been warned.  Thanks for being so brave.
")))
    (define (normal-tty tty)
      (mingetty-service tty
                        #:motd motd
                        #:auto-login "root"
                        #:login-pause? #t))

    (list (mingetty-service "tty1"
                            #:motd motd
                            #:auto-login "root")

          ;; 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 "tty2"
                            #:motd motd
                            #:auto-login "guest"
                            #:login-program (log-to-info))

          ;; Documentation add-on.
          (configuration-template-service)

          ;; A bunch of 'root' ttys.
          (normal-tty "tty3")
          (normal-tty "tty4")
          (normal-tty "tty5")
          (normal-tty "tty6")

          ;; The usual services.
          (syslog-service)

          ;; The build daemon.  Register the hydra.gnu.org key as trusted.
          ;; This allows the installation process to use substitutes by
          ;; default.
          (guix-service #:authorize-hydra-key? #t)

          ;; Start udev so that useful device nodes are available.
          (udev-service)

          ;; Add the 'cow-store' service, which users have to start manually
          ;; 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")

          ;; Since this is running on a USB stick with a unionfs as the root
          ;; file system, use an appropriate cache configuration.
          (nscd-service (nscd-configuration
                         (caches %nscd-minimal-caches))))))

(define %issue
  ;; Greeting.
  "
This is an installation image of the GNU system.  Welcome.

Use Alt-F2 for documentation.
")

(define installation-os
  ;; The operating system used on installation images for USB sticks etc.
  (operating-system
    (host-name "gnu")
    (timezone "Europe/Paris")
    (locale "en_US.utf8")
    (bootloader (grub-configuration
                 (device "/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")
             (type "ext4"))
           %base-file-systems))

    (users (list (user-account
                  (name "guest")
                  (group "users")
                  (supplementary-groups '("wheel"))  ; allow use of sudo
                  (password "")
                  (comment "Guest of GNU")
                  (home-directory "/home/guest"))))

    (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 '())

    (pam-services
     ;; Explicitly allow for empty passwords.
     (base-pam-services #:allow-empty-passwords? #t))

    (packages (cons* texinfo-4                 ;for the standalone Info reader
                     parted ddrescue
                     grub                  ;mostly so xrefs to its manual work
                     cryptsetup
                     wireless-tools iw wpa-supplicant-light
                     ;; 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.
                     %base-packages))))

;; Return it here so 'guix system' can consume it directly.
installation-os

;;; install.scm ends here
Commit	Line	Data
fc91c17a	1	;;; GNU Guix --- Functional package management for GNU
e87f0591	2	;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
fc91c17a LC	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)
e87f0591	22	#:use-module (guix store)
fc91c17a	23	#:use-module (guix monads)
83a17b62	24	#:use-module ((guix store) #:select (%store-prefix))
9d3fb6c7	25	#:use-module (guix profiles)
db84467a	26	#:use-module (gnu packages admin)
fc91c17a	27	#:use-module (gnu packages linux)
b419c7f5	28	#:use-module (gnu packages cryptsetup)
fc91c17a	29	#:use-module (gnu packages package-management)
cc4a2aeb	30	#:use-module (gnu packages disk)
7eda0c56	31	#:use-module (gnu packages grub)
fc91c17a	32	#:use-module (gnu packages texinfo)
dd6b28d1	33	#:use-module (gnu packages compression)
9d3fb6c7 LC	34	#:export (self-contained-tarball
9d3fb6c7 LC	35	installation-os))
fc91c17a LC	36
	37	;;; Commentary:
	38	;;;
	39	;;; This module provides an 'operating-system' definition for use on images
	40	;;; for USB sticks etc., for the installation of the GNU system.
	41	;;;
	42	;;; Code:
	43
9d3fb6c7 LC	44	\f
	45	(define* (self-contained-tarball #:key (guix guix))
	46	"Return a self-contained tarball containing a store initialized with the
	47	closure of GUIX. The tarball contains /gnu/store, /var/guix, and a profile
	48	under /root/.guix-profile where GUIX is installed."
	49	(mlet %store-monad ((profile (profile-derivation
	50	(manifest
	51	(list (package->manifest-entry guix))))))
	52	(define build
	53	#~(begin
	54	(use-modules (guix build utils)
	55	(gnu build install))
	56
	57	(define %root "root")
	58
	59	(setenv "PATH"
	60	(string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin"))
	61
	62	(populate-single-profile-directory %root
	63	#:profile #$profile
	64	#:closure "profile")
	65
	66	;; Create the tarball. Use GNU format so there's no file name
	67	;; length limitation.
	68	(with-directory-excursion %root
	69	(zero? (system* "tar" "--xz" "--format=gnu"
	70	"-cvf" #$output ".")))))
	71
	72	(gexp->derivation "guix-tarball.tar.xz" build
	73	#:references-graphs `(("profile" ,profile))
	74	#:modules '((guix build utils)
	75	(guix build store-copy)
	76	(gnu build install)))))
	77
	78	\f
fc91c17a LC	79	(define (log-to-info)
	80	"Return a script that spawns the Info reader on the right section of the
	81	manual."
	82	(gexp->script "log-to-info"
dd6b28d1 LC	83	#~(begin
	84	;; 'gunzip' is needed to decompress the doc.
	85	(setenv "PATH" (string-append #$gzip "/bin"))
	86
	87	(execl (string-append #$texinfo-4 "/bin/info") "info"
	88	"-d" "/run/current-system/profile/share/info"
	89	"-f" (string-append #$guix "/share/info/guix.info")
	90	"-n" "System Installation"))))
fc91c17a	91
83a17b62 LC	92	(define %backing-directory
	93	;; Sub-directory used as the backing store for copy-on-write.
	94	"/tmp/guix-inst")
	95
	96	(define (make-cow-store target)
	97	"Return a gexp that makes the store copy-on-write, using TARGET as the
	98	backing store. This is useful when TARGET is on a hard disk, whereas the
	99	current store is on a RAM disk."
	100	(define (unionfs read-only read-write mount-point)
	101	;; Make MOUNT-POINT the union of READ-ONLY and READ-WRITE.
	102
	103	;; Note: in the command below, READ-WRITE appears before READ-ONLY so that
	104	;; it is considered a "higher-level branch", as per unionfs-fuse(8),
	105	;; thereby allowing files existing on READ-ONLY to be copied over to
	106	;; READ-WRITE.
	107	#~(fork+exec-command
	108	(list (string-append #$unionfs-fuse "/bin/unionfs")
	109	"-o"
	110	"cow,allow_other,use_ino,max_files=65536,nonempty"
	111	(string-append #$read-write "=RW:" #$read-only "=RO")
	112	#$mount-point)))
	113
	114	(define (set-store-permissions directory)
	115	;; Set the right perms on DIRECTORY to use it as the store.
	116	#~(begin
	117	(chown #$directory 0 30000) ;use the fixed 'guixbuild' GID
	118	(chmod #$directory #o1775)))
	119
	120	#~(begin
	121	(unless (file-exists? "/.ro-store")
	122	(mkdir "/.ro-store")
	123	(mount #$(%store-prefix) "/.ro-store" "none"
	124	(logior MS_BIND MS_RDONLY)))
	125
	126	(let ((rw-dir (string-append target #$%backing-directory)))
	127	(mkdir-p rw-dir)
	128	(mkdir-p "/.rw-store")
	129	#$(set-store-permissions #~rw-dir)
	130	#$(set-store-permissions "/.rw-store")
	131
	132	;; Mount the union, then atomically make it the store.
	133	(and #$(unionfs "/.ro-store" #~rw-dir "/.rw-store")
	134	(begin
	135	(sleep 1) ;XXX: wait for unionfs to be ready
	136	(mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
	137	(rmdir "/.rw-store"))))))
	138
	139	(define (cow-store-service)
	140	"Return a service that makes the store copy-on-write, such that writes go to
	141	the user's target storage device rather than on the RAM disk."
	142	;; See <http://bugs.gnu.org/18061> for the initial report.
	143	(with-monad %store-monad
	144	(return (service
	145	(requirement '(root-file-system user-processes))
	146	(provision '(cow-store))
	147	(documentation
	148	"Make the store copy-on-write, with writes going to \
	149	the given target.")
fdaacbad LC	150
	151	;; This is meant to be explicitly started by the user.
	152	(auto-start? #f)
	153
83a17b62 LC	154	(start #~(case-lambda
	155	((target)
	156	#$(make-cow-store #~target)
	157	target)
	158	(else
	159	;; Do nothing, and mark the service as stopped.
	160	#f)))
	161	(stop #~(lambda (target)
	162	;; Delete the temporary directory, but leave everything
	163	;; mounted as there may still be processes using it
d6e2a622 LC	164	;; since 'user-processes' doesn't depend on us. The
	165	;; 'user-unmount' service will unmount TARGET
	166	;; eventually.
83a17b62 LC	167	(delete-file-recursively
	168	(string-append target #$%backing-directory))))))))
	169
1dac8566 LC	170	(define (configuration-template-service)
	171	"Return a dummy service whose purpose is to install an operating system
	172	configuration template file in the installation system."
	173
	174	(define local-template
	175	"/etc/configuration-template.scm")
	176	(define template
	177	(search-path %load-path "gnu/system/os-config.tmpl"))
	178
	179	(mlet %store-monad ((template (interned-file template)))
	180	(return (service
	181	(requirement '(root-file-system))
	182	(provision '(os-config-template))
	183	(documentation
	184	"This dummy service installs an OS configuration template.")
	185	(start #~(const #t))
	186	(stop #~(const #f))
	187	(activate
	188	#~(unless (file-exists? #$local-template)
	189	(copy-file #$template #$local-template)))))))
	190
61ff0a3a LC	191	(define %nscd-minimal-caches
	192	;; Minimal in-memory caching policy for nscd.
	193	(list (nscd-cache (database 'hosts)
	194	(positive-time-to-live (* 3600 12))
	195	(negative-time-to-live 20)
	196	(persistent? #f)
	197	(max-database-size (* 5 (expt 2 20)))))) ;5 MiB
	198
fc91c17a LC	199	(define (installation-services)
	200	"Return the list services for the installation image."
	201	(let ((motd (text-file "motd" "
c73adb09	202	Welcome to the installation of the Guix System Distribution!
fc91c17a LC	203
	204	There is NO WARRANTY, to the extent permitted by law. In particular, you may
	205	LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
	206	it is alpha software, so it may BREAK IN UNEXPECTED WAYS.
	207
	208	You have been warned. Thanks for being so brave.
	209	")))
	210	(define (normal-tty tty)
	211	(mingetty-service tty
	212	#:motd motd
	213	#:auto-login "root"
	214	#:login-pause? #t))
	215
	216	(list (mingetty-service "tty1"
	217	#:motd motd
	218	#:auto-login "root")
	219
62ca0fdf LC	220	;; Documentation. The manual is in UTF-8, but
	221	;; 'console-font-service' sets up Unicode support and loads a font
	222	;; with all the useful glyphs like em dash and quotation marks.
fc91c17a LC	223	(mingetty-service "tty2"
	224	#:motd motd
	225	#:auto-login "guest"
	226	#:login-program (log-to-info))
	227
1dac8566 LC	228	;; Documentation add-on.
	229	(configuration-template-service)
	230
fc91c17a LC	231	;; A bunch of 'root' ttys.
	232	(normal-tty "tty3")
	233	(normal-tty "tty4")
	234	(normal-tty "tty5")
	235	(normal-tty "tty6")
	236
	237	;; The usual services.
	238	(syslog-service)
2c5c696c LC	239
	240	;; The build daemon. Register the hydra.gnu.org key as trusted.
	241	;; This allows the installation process to use substitutes by
	242	;; default.
	243	(guix-service #:authorize-hydra-key? #t)
	244
e11390df LC	245	;; Start udev so that useful device nodes are available.
	246	(udev-service)
	247
83a17b62 LC	248	;; Add the 'cow-store' service, which users have to start manually
	249	;; since it takes the installation directory as an argument.
	250	(cow-store-service)
	251
62ca0fdf LC	252	;; Install Unicode support and a suitable font.
	253	(console-font-service "tty1")
	254	(console-font-service "tty2")
	255	(console-font-service "tty3")
	256	(console-font-service "tty4")
	257	(console-font-service "tty5")
	258	(console-font-service "tty6")
	259
61ff0a3a LC	260	;; Since this is running on a USB stick with a unionfs as the root
	261	;; file system, use an appropriate cache configuration.
	262	(nscd-service (nscd-configuration
	263	(caches %nscd-minimal-caches))))))
fc91c17a LC	264
	265	(define %issue
	266	;; Greeting.
	267	"
	268	This is an installation image of the GNU system. Welcome.
	269
	270	Use Alt-F2 for documentation.
	271	")
	272
	273	(define installation-os
	274	;; The operating system used on installation images for USB sticks etc.
	275	(operating-system
	276	(host-name "gnu")
	277	(timezone "Europe/Paris")
9cd0dfaa	278	(locale "en_US.utf8")
fc91c17a LC	279	(bootloader (grub-configuration
	280	(device "/dev/sda")))
	281	(file-systems
	282	;; Note: the disk image build code overrides this root file system with
	283	;; the appropriate one.
a69576ea	284	(cons (file-system
fc91c17a LC	285	(mount-point "/")
fc91c17a LC	286	(device "gnu-disk-image")
a69576ea LC	287	(type "ext4"))
a69576ea LC	288	%base-file-systems))
fc91c17a LC	289
	290	(users (list (user-account
	291	(name "guest")
72507e23 LC	292	(group "users")
72507e23 LC	293	(supplementary-groups '("wheel")) ; allow use of sudo
fc91c17a LC	294	(password "")
	295	(comment "Guest of GNU")
	296	(home-directory "/home/guest"))))
fc91c17a LC	297
	298	(issue %issue)
	299
	300	(services (installation-services))
	301
	302	;; We don't need setuid programs so pass the empty list so we don't pull
	303	;; additional programs here.
	304	(setuid-programs '())
	305
	306	(pam-services
	307	;; Explicitly allow for empty passwords.
	308	(base-pam-services #:allow-empty-passwords? #t))
	309
7eda0c56	310	(packages (cons* texinfo-4 ;for the standalone Info reader
8f297d42	311	parted ddrescue
7eda0c56	312	grub ;mostly so xrefs to its manual work
b419c7f5	313	cryptsetup
4fb7e0de	314	wireless-tools iw wpa-supplicant-light
8f297d42 LC	315	;; XXX: We used to have GNU fdisk here, but as of version
	316	;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
	317	;; space; furthermore util-linux's fdisk is already
	318	;; available here, so we keep that.
6f436c54	319	%base-packages))))
fc91c17a LC	320
	321	;; Return it here so 'guix system' can consume it directly.
	322	installation-os
	323
	324	;;; install.scm ends here