Commit | Line | Data |
---|---|---|
fc91c17a | 1 | ;;; GNU Guix --- Functional package management for GNU |
efdcb6f2 | 2 | ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
b2a5fa59 | 3 | ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> |
fc91c17a LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu system install) | |
21 | #:use-module (gnu) | |
22 | #:use-module (guix gexp) | |
e87f0591 | 23 | #:use-module (guix store) |
fc91c17a | 24 | #:use-module (guix monads) |
83a17b62 | 25 | #:use-module ((guix store) #:select (%store-prefix)) |
9d3fb6c7 | 26 | #:use-module (guix profiles) |
0190c1c0 | 27 | #:use-module (gnu services shepherd) |
db84467a | 28 | #:use-module (gnu packages admin) |
f4bdfe73 | 29 | #:use-module (gnu packages bash) |
fc91c17a | 30 | #:use-module (gnu packages linux) |
b419c7f5 | 31 | #:use-module (gnu packages cryptsetup) |
fc91c17a | 32 | #:use-module (gnu packages package-management) |
cc4a2aeb | 33 | #:use-module (gnu packages disk) |
7eda0c56 | 34 | #:use-module (gnu packages grub) |
fc91c17a | 35 | #:use-module (gnu packages texinfo) |
dd6b28d1 | 36 | #:use-module (gnu packages compression) |
e1fbc32a LC |
37 | #:use-module (ice-9 match) |
38 | #:use-module (srfi srfi-26) | |
9d3fb6c7 LC |
39 | #:export (self-contained-tarball |
40 | installation-os)) | |
fc91c17a LC |
41 | |
42 | ;;; Commentary: | |
43 | ;;; | |
44 | ;;; This module provides an 'operating-system' definition for use on images | |
45 | ;;; for USB sticks etc., for the installation of the GNU system. | |
46 | ;;; | |
47 | ;;; Code: | |
48 | ||
9d3fb6c7 LC |
49 | \f |
50 | (define* (self-contained-tarball #:key (guix guix)) | |
51 | "Return a self-contained tarball containing a store initialized with the | |
52 | closure of GUIX. The tarball contains /gnu/store, /var/guix, and a profile | |
53 | under /root/.guix-profile where GUIX is installed." | |
54 | (mlet %store-monad ((profile (profile-derivation | |
55 | (manifest | |
56 | (list (package->manifest-entry guix)))))) | |
57 | (define build | |
58 | #~(begin | |
59 | (use-modules (guix build utils) | |
60 | (gnu build install)) | |
61 | ||
62 | (define %root "root") | |
63 | ||
64 | (setenv "PATH" | |
65 | (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin")) | |
66 | ||
08fa7613 LC |
67 | ;; Note: there is not much to gain here with deduplication and there |
68 | ;; is the overhead of the '.links' directory, so turn it off. | |
9d3fb6c7 LC |
69 | (populate-single-profile-directory %root |
70 | #:profile #$profile | |
08fa7613 LC |
71 | #:closure "profile" |
72 | #:deduplicate? #f) | |
9d3fb6c7 LC |
73 | |
74 | ;; Create the tarball. Use GNU format so there's no file name | |
01dbc7e0 | 75 | ;; length limitation. |
9d3fb6c7 LC |
76 | (with-directory-excursion %root |
77 | (zero? (system* "tar" "--xz" "--format=gnu" | |
92226a47 | 78 | |
34a7bfb0 LC |
79 | ;; Avoid non-determinism in the archive. Use |
80 | ;; mtime = 1, not zero, because that is what the | |
81 | ;; daemon does for files in the store (see the | |
82 | ;; 'mtimeStore' constant in local-store.cc.) | |
92226a47 | 83 | "--sort=name" |
34a7bfb0 | 84 | "--mtime=@1" ;for files in /var/guix |
92226a47 MW |
85 | "--owner=root:0" |
86 | "--group=root:0" | |
87 | ||
08fa7613 | 88 | "--check-links" |
b2a5fa59 | 89 | "-cvf" #$output |
7acd3439 | 90 | ;; Avoid adding / and /var to the tarball, |
b2a5fa59 MW |
91 | ;; so that the ownership and permissions of those |
92 | ;; directories will not be overwritten when | |
7acd3439 LC |
93 | ;; extracting the archive. Do not include /root |
94 | ;; because the root account might have a different | |
95 | ;; home directory. | |
b2a5fa59 | 96 | "./var/guix" |
781d0a2c | 97 | (string-append "." (%store-directory))))))) |
9d3fb6c7 LC |
98 | |
99 | (gexp->derivation "guix-tarball.tar.xz" build | |
100 | #:references-graphs `(("profile" ,profile)) | |
101 | #:modules '((guix build utils) | |
102 | (guix build store-copy) | |
103 | (gnu build install))))) | |
104 | ||
105 | \f | |
fc91c17a LC |
106 | (define (log-to-info) |
107 | "Return a script that spawns the Info reader on the right section of the | |
108 | manual." | |
ce8a6dfc | 109 | (program-file "log-to-info" |
dd6b28d1 LC |
110 | #~(begin |
111 | ;; 'gunzip' is needed to decompress the doc. | |
112 | (setenv "PATH" (string-append #$gzip "/bin")) | |
113 | ||
68abb9b0 | 114 | (execl (string-append #$info-reader "/bin/info") "info" |
dd6b28d1 LC |
115 | "-d" "/run/current-system/profile/share/info" |
116 | "-f" (string-append #$guix "/share/info/guix.info") | |
117 | "-n" "System Installation")))) | |
fc91c17a | 118 | |
83a17b62 LC |
119 | (define %backing-directory |
120 | ;; Sub-directory used as the backing store for copy-on-write. | |
121 | "/tmp/guix-inst") | |
122 | ||
123 | (define (make-cow-store target) | |
124 | "Return a gexp that makes the store copy-on-write, using TARGET as the | |
125 | backing store. This is useful when TARGET is on a hard disk, whereas the | |
126 | current store is on a RAM disk." | |
127 | (define (unionfs read-only read-write mount-point) | |
128 | ;; Make MOUNT-POINT the union of READ-ONLY and READ-WRITE. | |
129 | ||
130 | ;; Note: in the command below, READ-WRITE appears before READ-ONLY so that | |
131 | ;; it is considered a "higher-level branch", as per unionfs-fuse(8), | |
132 | ;; thereby allowing files existing on READ-ONLY to be copied over to | |
133 | ;; READ-WRITE. | |
134 | #~(fork+exec-command | |
135 | (list (string-append #$unionfs-fuse "/bin/unionfs") | |
136 | "-o" | |
137 | "cow,allow_other,use_ino,max_files=65536,nonempty" | |
138 | (string-append #$read-write "=RW:" #$read-only "=RO") | |
139 | #$mount-point))) | |
140 | ||
141 | (define (set-store-permissions directory) | |
142 | ;; Set the right perms on DIRECTORY to use it as the store. | |
143 | #~(begin | |
144 | (chown #$directory 0 30000) ;use the fixed 'guixbuild' GID | |
145 | (chmod #$directory #o1775))) | |
146 | ||
147 | #~(begin | |
0adabad7 LC |
148 | ;; Bind-mount TARGET's /tmp in case we need space to build things. |
149 | (let ((tmpdir (string-append #$target "/tmp"))) | |
150 | (mkdir-p tmpdir) | |
151 | (mount tmpdir "/tmp" "none" MS_BIND)) | |
152 | ||
83a17b62 LC |
153 | (unless (file-exists? "/.ro-store") |
154 | (mkdir "/.ro-store") | |
155 | (mount #$(%store-prefix) "/.ro-store" "none" | |
156 | (logior MS_BIND MS_RDONLY))) | |
157 | ||
158 | (let ((rw-dir (string-append target #$%backing-directory))) | |
159 | (mkdir-p rw-dir) | |
160 | (mkdir-p "/.rw-store") | |
161 | #$(set-store-permissions #~rw-dir) | |
162 | #$(set-store-permissions "/.rw-store") | |
163 | ||
164 | ;; Mount the union, then atomically make it the store. | |
165 | (and #$(unionfs "/.ro-store" #~rw-dir "/.rw-store") | |
166 | (begin | |
167 | (sleep 1) ;XXX: wait for unionfs to be ready | |
168 | (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE) | |
169 | (rmdir "/.rw-store")))))) | |
170 | ||
0adfe95a | 171 | (define cow-store-service-type |
d4053c71 | 172 | (shepherd-service-type |
00184239 | 173 | 'cow-store |
0adfe95a | 174 | (lambda _ |
d4053c71 | 175 | (shepherd-service |
0adfe95a LC |
176 | (requirement '(root-file-system user-processes)) |
177 | (provision '(cow-store)) | |
178 | (documentation | |
179 | "Make the store copy-on-write, with writes going to \ | |
180 | the given target.") | |
181 | ||
182 | ;; This is meant to be explicitly started by the user. | |
183 | (auto-start? #f) | |
184 | ||
185 | (start #~(case-lambda | |
186 | ((target) | |
187 | #$(make-cow-store #~target) | |
188 | target) | |
189 | (else | |
190 | ;; Do nothing, and mark the service as stopped. | |
191 | #f))) | |
192 | (stop #~(lambda (target) | |
193 | ;; Delete the temporary directory, but leave everything | |
194 | ;; mounted as there may still be processes using it since | |
195 | ;; 'user-processes' doesn't depend on us. The 'user-unmount' | |
196 | ;; service will unmount TARGET eventually. | |
197 | (delete-file-recursively | |
198 | (string-append target #$%backing-directory)))))))) | |
199 | ||
83a17b62 LC |
200 | (define (cow-store-service) |
201 | "Return a service that makes the store copy-on-write, such that writes go to | |
202 | the user's target storage device rather than on the RAM disk." | |
203 | ;; See <http://bugs.gnu.org/18061> for the initial report. | |
0adfe95a LC |
204 | (service cow-store-service-type 'mooooh!)) |
205 | ||
206 | ||
207 | (define (/etc/configuration-files _) | |
208 | "Return a list of tuples representing configuration templates to add to | |
209 | /etc." | |
210 | (define (file f) | |
211 | (local-file (search-path %load-path | |
212 | (string-append "gnu/system/examples/" f)))) | |
213 | ||
214 | (define directory | |
215 | (computed-file "configuration-templates" | |
216 | #~(begin | |
217 | (mkdir #$output) | |
218 | (for-each (lambda (file target) | |
219 | (copy-file file | |
220 | (string-append #$output "/" | |
221 | target))) | |
222 | '(#$(file "bare-bones.tmpl") | |
d038b674 LC |
223 | #$(file "desktop.tmpl") |
224 | #$(file "lightweight-desktop.tmpl")) | |
0adfe95a | 225 | '("bare-bones.scm" |
d038b674 LC |
226 | "desktop.scm" |
227 | "lightweight-desktop.scm")) | |
0adfe95a LC |
228 | #t) |
229 | #:modules '((guix build utils)))) | |
230 | ||
231 | `(("configuration" ,directory))) | |
232 | ||
233 | (define configuration-template-service-type | |
234 | (service-type (name 'configuration-template) | |
235 | (extensions | |
236 | (list (service-extension etc-service-type | |
237 | /etc/configuration-files))))) | |
238 | ||
239 | (define %configuration-template-service | |
240 | (service configuration-template-service-type #t)) | |
be1c2c54 | 241 | |
1dac8566 | 242 | |
61ff0a3a LC |
243 | (define %nscd-minimal-caches |
244 | ;; Minimal in-memory caching policy for nscd. | |
245 | (list (nscd-cache (database 'hosts) | |
246 | (positive-time-to-live (* 3600 12)) | |
c96ba2cf LC |
247 | |
248 | ;; Do not cache lookup failures at all since they are | |
249 | ;; quite likely (for instance when someone tries to ping a | |
250 | ;; host before networking is functional.) | |
251 | (negative-time-to-live 0) | |
252 | ||
61ff0a3a LC |
253 | (persistent? #f) |
254 | (max-database-size (* 5 (expt 2 20)))))) ;5 MiB | |
255 | ||
fc91c17a LC |
256 | (define (installation-services) |
257 | "Return the list services for the installation image." | |
ce8a6dfc | 258 | (let ((motd (plain-file "motd" " |
c73adb09 | 259 | Welcome to the installation of the Guix System Distribution! |
fc91c17a LC |
260 | |
261 | There is NO WARRANTY, to the extent permitted by law. In particular, you may | |
262 | LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore, | |
c82c060d | 263 | it is 'beta' software, so it may contain bugs. |
fc91c17a LC |
264 | |
265 | You have been warned. Thanks for being so brave. | |
266 | "))) | |
267 | (define (normal-tty tty) | |
66e4f01c LC |
268 | (mingetty-service (mingetty-configuration (tty tty) |
269 | (motd motd) | |
270 | (auto-login "root") | |
271 | (login-pause? #t)))) | |
fc91c17a | 272 | |
66e4f01c LC |
273 | (list (mingetty-service (mingetty-configuration |
274 | (tty "tty1") | |
275 | (motd motd) | |
276 | (auto-login "root"))) | |
fc91c17a | 277 | |
62ca0fdf LC |
278 | ;; Documentation. The manual is in UTF-8, but |
279 | ;; 'console-font-service' sets up Unicode support and loads a font | |
280 | ;; with all the useful glyphs like em dash and quotation marks. | |
66e4f01c LC |
281 | (mingetty-service (mingetty-configuration |
282 | (tty "tty2") | |
283 | (motd motd) | |
284 | (auto-login "guest") | |
285 | (login-program (log-to-info)))) | |
fc91c17a | 286 | |
1dac8566 | 287 | ;; Documentation add-on. |
0adfe95a | 288 | %configuration-template-service |
1dac8566 | 289 | |
fc91c17a LC |
290 | ;; A bunch of 'root' ttys. |
291 | (normal-tty "tty3") | |
292 | (normal-tty "tty4") | |
293 | (normal-tty "tty5") | |
294 | (normal-tty "tty6") | |
295 | ||
296 | ;; The usual services. | |
297 | (syslog-service) | |
2c5c696c LC |
298 | |
299 | ;; The build daemon. Register the hydra.gnu.org key as trusted. | |
300 | ;; This allows the installation process to use substitutes by | |
301 | ;; default. | |
0adfe95a | 302 | (guix-service (guix-configuration (authorize-key? #t))) |
2c5c696c | 303 | |
e11390df | 304 | ;; Start udev so that useful device nodes are available. |
68ac258b LC |
305 | ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for |
306 | ;; regulations-compliant WiFi access. | |
307 | (udev-service #:rules (list lvm2 crda)) | |
e11390df | 308 | |
83a17b62 LC |
309 | ;; Add the 'cow-store' service, which users have to start manually |
310 | ;; since it takes the installation directory as an argument. | |
311 | (cow-store-service) | |
312 | ||
62ca0fdf LC |
313 | ;; Install Unicode support and a suitable font. |
314 | (console-font-service "tty1") | |
315 | (console-font-service "tty2") | |
316 | (console-font-service "tty3") | |
317 | (console-font-service "tty4") | |
318 | (console-font-service "tty5") | |
319 | (console-font-service "tty6") | |
320 | ||
ae7ffa9e LC |
321 | ;; To facilitate copy/paste. |
322 | (gpm-service) | |
323 | ||
61ff0a3a LC |
324 | ;; Since this is running on a USB stick with a unionfs as the root |
325 | ;; file system, use an appropriate cache configuration. | |
326 | (nscd-service (nscd-configuration | |
327 | (caches %nscd-minimal-caches)))))) | |
fc91c17a LC |
328 | |
329 | (define %issue | |
330 | ;; Greeting. | |
331 | " | |
332 | This is an installation image of the GNU system. Welcome. | |
333 | ||
334 | Use Alt-F2 for documentation. | |
335 | ") | |
336 | ||
337 | (define installation-os | |
338 | ;; The operating system used on installation images for USB sticks etc. | |
339 | (operating-system | |
340 | (host-name "gnu") | |
341 | (timezone "Europe/Paris") | |
9cd0dfaa | 342 | (locale "en_US.utf8") |
fc91c17a LC |
343 | (bootloader (grub-configuration |
344 | (device "/dev/sda"))) | |
345 | (file-systems | |
346 | ;; Note: the disk image build code overrides this root file system with | |
347 | ;; the appropriate one. | |
ee03b75d LC |
348 | (cons* (file-system |
349 | (mount-point "/") | |
350 | (device "gnu-disk-image") | |
351 | (title 'label) | |
352 | (type "ext4")) | |
353 | ||
354 | ;; Make /tmp a tmpfs instead of keeping the unionfs. This is | |
355 | ;; because FUSE creates '.fuse_hiddenXYZ' files for each open file, | |
356 | ;; and this confuses Guix's test suite, for instance. See | |
357 | ;; <http://bugs.gnu.org/23056>. | |
358 | (file-system | |
359 | (mount-point "/tmp") | |
360 | (device "none") | |
361 | (title 'device) | |
362 | (type "tmpfs") | |
363 | (check? #f)) | |
364 | ||
0feefb53 LC |
365 | ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need |
366 | ;; elogind's cgroup file systems. | |
367 | (list %pseudo-terminal-file-system | |
368 | %shared-memory-file-system | |
369 | %immutable-store))) | |
fc91c17a LC |
370 | |
371 | (users (list (user-account | |
372 | (name "guest") | |
72507e23 | 373 | (group "users") |
ee03b75d | 374 | (supplementary-groups '("wheel")) ; allow use of sudo |
fc91c17a LC |
375 | (password "") |
376 | (comment "Guest of GNU") | |
377 | (home-directory "/home/guest")))) | |
fc91c17a LC |
378 | |
379 | (issue %issue) | |
380 | ||
381 | (services (installation-services)) | |
382 | ||
383 | ;; We don't need setuid programs so pass the empty list so we don't pull | |
384 | ;; additional programs here. | |
385 | (setuid-programs '()) | |
386 | ||
387 | (pam-services | |
388 | ;; Explicitly allow for empty passwords. | |
389 | (base-pam-services #:allow-empty-passwords? #t)) | |
390 | ||
a6312f1d | 391 | (packages (cons* (canonical-package glibc) ;for 'tzselect' & co. |
8f297d42 | 392 | parted ddrescue |
7eda0c56 | 393 | grub ;mostly so xrefs to its manual work |
b419c7f5 | 394 | cryptsetup |
3a9cfba8 | 395 | btrfs-progs |
1ce6f43a | 396 | wireless-tools iw wpa-supplicant-minimal iproute |
8f297d42 LC |
397 | ;; XXX: We used to have GNU fdisk here, but as of version |
398 | ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable | |
399 | ;; space; furthermore util-linux's fdisk is already | |
400 | ;; available here, so we keep that. | |
f4bdfe73 | 401 | bash-completion |
6f436c54 | 402 | %base-packages)))) |
fc91c17a LC |
403 | |
404 | ;; Return it here so 'guix system' can consume it directly. | |
405 | installation-os | |
406 | ||
407 | ;;; install.scm ends here |