1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (gnu system)
20 #:use-module (guix store)
21 #:use-module (guix monads)
22 #:use-module (guix gexp)
23 #:use-module (guix records)
24 #:use-module (guix packages)
25 #:use-module (guix derivations)
26 #:use-module (guix profiles)
27 #:use-module (gnu packages base)
28 #:use-module (gnu packages bash)
29 #:use-module (gnu packages guile)
30 #:use-module (gnu packages which)
31 #:use-module (gnu packages admin)
32 #:use-module (gnu packages linux)
33 #:use-module (gnu packages package-management)
34 #:use-module (gnu packages which)
35 #:use-module (gnu packages less)
36 #:use-module (gnu packages zile)
37 #:use-module (gnu packages nano)
38 #:use-module (gnu packages lsof)
39 #:use-module (gnu services)
40 #:use-module (gnu services dmd)
41 #:use-module (gnu services base)
42 #:use-module (gnu system grub)
43 #:use-module (gnu system shadow)
44 #:use-module (gnu system linux)
45 #:use-module (gnu system linux-initrd)
46 #:use-module (gnu system file-systems)
47 #:use-module (ice-9 match)
48 #:use-module (srfi srfi-1)
49 #:use-module (srfi srfi-26)
50 #:export (operating-system
53 operating-system-bootloader
54 operating-system-services
55 operating-system-user-services
56 operating-system-packages
57 operating-system-host-name
58 operating-system-kernel
59 operating-system-initrd
60 operating-system-users
61 operating-system-groups
62 operating-system-issue
63 operating-system-packages
64 operating-system-timezone
65 operating-system-locale
66 operating-system-file-systems
67 operating-system-activation-script
69 operating-system-derivation
70 operating-system-profile
71 operating-system-grub.cfg
77 ;;; This module supports whole-system configuration.
81 ;; System-wide configuration.
82 ;; TODO: Add per-field docstrings/stexi.
83 (define-record-type* <operating-system> operating-system
86 (kernel operating-system-kernel ; package
87 (default linux-libre))
88 (bootloader operating-system-bootloader) ; <grub-configuration>
90 (initrd operating-system-initrd ; (list fs) -> M derivation
91 (default base-initrd))
93 (host-name operating-system-host-name) ; string
95 (file-systems operating-system-file-systems) ; list of fs
97 (users operating-system-users ; list of user accounts
99 (groups operating-system-groups ; list of user groups
100 (default %base-groups))
102 (skeletons operating-system-skeletons ; list of name/monadic value
103 (default (default-skeletons)))
104 (issue operating-system-issue ; string
105 (default %default-issue))
107 (packages operating-system-packages ; list of (PACKAGE OUTPUT...)
108 (default %base-packages)) ; or just PACKAGE
110 (timezone operating-system-timezone) ; string
111 (locale operating-system-locale ; string
112 (default "en_US.UTF-8"))
114 (services operating-system-user-services ; list of monadic services
115 (default %base-services))
117 (pam-services operating-system-pam-services ; list of PAM services
118 (default (base-pam-services)))
119 (setuid-programs operating-system-setuid-programs
120 (default %setuid-programs)) ; list of string-valued gexps
122 (sudoers operating-system-sudoers ; /etc/sudoers contents
123 (default %sudoers-specification)))
130 (define* (file-union name files)
131 "Return a derivation that builds a directory containing all of FILES. Each
132 item in FILES must be a list where the first element is the file name to use
133 in the new directory, and the second element is a gexp denoting the target
139 #$@(map (match-lambda
141 #~(symlink #$source #$target)))
144 (gexp->derivation name builder))
151 (define (other-file-system-services os)
152 "Return file system services for the file systems of OS that are not marked
153 as 'needed-for-boot'."
156 (or (file-system-needed-for-boot? fs)
157 (string=? "/" (file-system-mount-point fs))))
158 (operating-system-file-systems os)))
160 (sequence %store-monad
162 (($ <file-system> device title target type flags opts
164 (file-system-service device target type
167 #:create-mount-point? create?
172 (define (essential-services os)
173 "Return the list of essential services for OS. These are special services
174 that implement part of what's declared in OS are responsible for low-level
176 (mlet* %store-monad ((root-fs (root-file-system-service))
177 (other-fs (other-file-system-services os))
178 (procs (user-processes-service
179 (map (compose first service-provision)
181 (host-name (host-name-service
182 (operating-system-host-name os))))
183 (return (cons* host-name procs root-fs other-fs))))
185 (define (operating-system-services os)
186 "Return all the services of OS, including \"internal\" services that do not
187 explicitly appear in OS."
189 ((user (sequence %store-monad (operating-system-user-services os)))
190 (essential (essential-services os)))
191 (return (append essential user))))
198 (define %base-packages
199 ;; Default set of packages globally visible. It should include anything
200 ;; required for basic administrator tasks.
201 (cons* procps psmisc which less zile nano
202 (@ (gnu packages admin) dmd) guix
203 lsof ;for Guix's 'list-runtime-roots'
204 util-linux inetutils isc-dhcp
205 net-tools ; XXX: remove when Inetutils suffices
207 ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
208 ;; already depends on it anyway.
213 ;; The packages below are also in %FINAL-INPUTS, so take them from
214 ;; there to avoid duplication.
215 (map canonical-package
216 (list guile-2.0 bash coreutils findutils grep sed))))
218 (define %default-issue
219 ;; Default contents for /etc/issue.
221 This is the GNU system. Welcome.\n")
223 (define* (etc-directory #:key
224 (locale "C") (timezone "Europe/Paris")
228 (profile "/run/current-system/profile")
230 "Return a derivation that builds the static part of the /etc directory."
232 ((pam.d (pam-services->directory pam-services))
233 (sudoers (text-file "sudoers" sudoers))
234 (login.defs (text-file "login.defs" "# Empty for now.\n"))
235 (shells (text-file "shells" ; used by xterm and others
238 /run/current-system/profile/bin/sh
239 /run/current-system/profile/bin/bash\n"))
240 (issue (text-file "issue" issue))
242 ;; TODO: Generate bashrc from packages' search-paths.
243 (bashrc (text-file* "bashrc" "
244 export PS1='\\u@\\h\\$ '
246 export LC_ALL=\"" locale "\"
247 export TZ=\"" timezone "\"
248 export TZDIR=\"" tzdata "/share/zoneinfo\"
250 # Tell 'modprobe' & co. where to look for modules.
251 export LINUX_MODULE_DIRECTORY=/run/booted-system/kernel/lib/modules
253 export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin
254 export PATH=/run/setuid-programs:/run/current-system/profile/sbin:$PATH
255 export CPATH=$HOME/.guix-profile/include:" profile "/include
256 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
257 alias ls='ls -p --color'
260 (skel (skeleton-directory skeletons)))
262 `(("services" ,#~(string-append #$net-base "/etc/services"))
263 ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
264 ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
266 ("login.defs" ,#~#$login.defs)
269 ("shells" ,#~#$shells)
270 ("profile" ,#~#$bashrc)
271 ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
273 ("sudoers" ,#~#$sudoers)))))
275 (define (operating-system-profile os)
276 "Return a derivation that builds the system profile of OS."
277 (profile-derivation (manifest (map package->manifest-entry
278 (operating-system-packages os)))))
280 (define %root-account
281 ;; Default root account.
285 (uid 0) (group "root")
286 (comment "System administrator")
287 (home-directory "/root")))
289 (define (operating-system-accounts os)
290 "Return the user accounts for OS, including an obligatory 'root' account."
292 ;; Make sure there's a root account.
293 (if (find (lambda (user)
294 (and=> (user-account-uid user) zero?))
295 (operating-system-users os))
296 (operating-system-users os)
297 (cons %root-account (operating-system-users os))))
299 (mlet %store-monad ((services (operating-system-services os)))
300 (return (append users
301 (append-map service-user-accounts services)))))
303 (define (operating-system-etc-directory os)
304 "Return that static part of the /etc directory of OS."
306 ((services (operating-system-services os))
308 ;; Services known to PAM.
310 (append (operating-system-pam-services os)
311 (append-map service-pam-services services))))
312 (profile-drv (operating-system-profile os))
313 (skeletons (operating-system-skeletons os)))
314 (etc-directory #:pam-services pam-services
315 #:skeletons skeletons
316 #:issue (operating-system-issue os)
317 #:locale (operating-system-locale os)
318 #:timezone (operating-system-timezone os)
319 #:sudoers (operating-system-sudoers os)
320 #:profile profile-drv)))
322 (define %setuid-programs
323 ;; Default set of setuid-root programs.
324 (let ((shadow (@ (gnu packages admin) shadow)))
325 (list #~(string-append #$shadow "/bin/passwd")
326 #~(string-append #$shadow "/bin/su")
327 #~(string-append #$inetutils "/bin/ping")
328 #~(string-append #$sudo "/bin/sudo")
329 #~(string-append #$fuse "/bin/fusermount"))))
331 (define %sudoers-specification
332 ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
333 ;; group can do anything. See
334 ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
335 ;; TODO: Add a declarative API.
337 %wheel ALL=(ALL) ALL\n")
339 (define (user-group->gexp group)
340 "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
342 #~(list #$(user-group-name group)
343 #$(user-group-password group)
344 #$(user-group-id group)
345 #$(user-group-system? group)))
347 (define (user-account->gexp account)
348 "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
350 #~`(#$(user-account-name account)
351 #$(user-account-uid account)
352 #$(user-account-group account)
353 #$(user-account-supplementary-groups account)
354 #$(user-account-comment account)
355 #$(user-account-home-directory account)
356 ,#$(user-account-shell account) ; this one is a gexp
357 #$(user-account-password account)
358 #$(user-account-system? account)))
360 (define (operating-system-activation-script os)
361 "Return the activation script for OS---i.e., the code that \"activates\" the
362 stateful part of OS, including user accounts and groups, special directories,
365 '((guix build activation)
367 (guix build linux-initrd)))
369 (define (service-activations services)
370 ;; Return the activation scripts for SERVICES.
371 (let ((gexps (filter-map service-activate services)))
372 (sequence %store-monad (map (cut gexp->file "activate-service.scm" <>)
375 (mlet* %store-monad ((services (operating-system-services os))
376 (actions (service-activations services))
377 (etc (operating-system-etc-directory os))
378 (modules (imported-modules %modules))
379 (compiled (compiled-modules %modules))
380 (accounts (operating-system-accounts os)))
382 (operating-system-setuid-programs os))
385 (map user-account->gexp accounts))
388 (append (operating-system-groups os)
389 (append-map service-user-groups services)))
392 (map user-group->gexp groups))
394 (gexp->file "activate"
396 (eval-when (expand load eval)
397 ;; Make sure 'use-modules' below succeeds.
398 (set! %load-path (cons #$modules %load-path))
399 (set! %load-compiled-path
400 (cons #$compiled %load-compiled-path)))
402 (use-modules (guix build activation))
407 ;; Add users and user groups.
409 (string-append #$(@ (gnu packages admin) shadow)
411 (activate-users+groups (list #$@user-specs)
412 (list #$@group-specs))
414 ;; Activate setuid programs.
415 (activate-setuid-programs (list #$@setuid-progs))
417 ;; Run the services' activation snippets.
418 ;; TODO: Use 'load-compiled'.
419 (for-each primitive-load '#$actions)
421 ;; Set up /run/current-system.
422 (activate-current-system)))))
424 (define (operating-system-boot-script os)
425 "Return the boot script for OS---i.e., the code started by the initrd once
426 we're running in the final root."
427 (mlet* %store-monad ((services (operating-system-services os))
428 (activate (operating-system-activation-script os))
429 (dmd-conf (dmd-configuration-file services)))
432 ;; Activate the system.
433 ;; TODO: Use 'load-compiled'.
434 (primitive-load #$activate)
436 ;; Keep track of the booted system.
437 (false-if-exception (delete-file "/run/booted-system"))
438 (symlink (readlink "/run/current-system")
439 "/run/booted-system")
441 ;; Close any remaining open file descriptors to be on the
442 ;; safe side. This must be the very last thing we do,
443 ;; because Guile has internal FDs such as 'sleep_pipe'
444 ;; that need to be alive.
447 (false-if-exception (close-fdes fd))
451 (execl (string-append #$dmd "/bin/dmd")
452 "dmd" "--config" #$dmd-conf)))))
454 (define (operating-system-root-file-system os)
455 "Return the root file system of OS."
457 (($ <file-system> _ _ "/") #t)
459 (operating-system-file-systems os)))
461 (define (operating-system-initrd-file os)
462 "Return a gexp denoting the initrd file of OS."
463 (define boot-file-systems
464 (filter (match-lambda
465 (($ <file-system> device title "/")
467 (($ <file-system> device title mount-point type flags
470 (operating-system-file-systems os)))
473 ((initrd ((operating-system-initrd os) boot-file-systems)))
474 (return #~(string-append #$initrd "/initrd"))))
476 (define (kernel->grub-label kernel)
477 "Return a label for the GRUB menu entry that boots KERNEL."
478 (string-append "GNU system with "
479 (string-titlecase (package-name kernel)) " "
480 (package-version kernel)
481 " (technology preview)"))
483 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
484 "Return the GRUB configuration file for OS. Use OLD-ENTRIES to populate the
485 \"old entries\" menu."
487 ((system (operating-system-derivation os))
488 (root-fs -> (operating-system-root-file-system os))
489 (kernel -> (operating-system-kernel os))
490 (entries -> (list (menu-entry
491 (label (kernel->grub-label kernel))
494 (list (string-append "--root="
495 (file-system-device root-fs))
496 #~(string-append "--system=" #$system)
497 #~(string-append "--load=" #$system
499 (initrd #~(string-append #$system "/initrd"))))))
500 (grub-configuration-file (operating-system-bootloader os) entries
501 #:old-entries old-entries)))
503 (define (operating-system-parameters-file os)
504 "Return a file that describes the boot parameters of OS. The primary use of
505 this file is the reconstruction of GRUB menu entries for old configurations."
506 (mlet %store-monad ((initrd (operating-system-initrd-file os))
507 (root -> (operating-system-root-file-system os))
508 (label -> (kernel->grub-label
509 (operating-system-kernel os))))
510 (gexp->file "parameters"
511 #~(boot-parameters (version 0)
513 (root-device #$(file-system-device root))
514 (kernel #$(operating-system-kernel os))
515 (initrd #$initrd)))))
517 (define (operating-system-derivation os)
518 "Return a derivation that builds OS."
520 ((profile (operating-system-profile os))
521 (etc (operating-system-etc-directory os))
522 (boot (operating-system-boot-script os))
523 (kernel -> (operating-system-kernel os))
524 (initrd (operating-system-initrd-file os))
525 (params (operating-system-parameters-file os)))
528 ("kernel" ,#~#$kernel)
529 ("parameters" ,#~#$params)
531 ("profile" ,#~#$profile)
534 ;;; system.scm ends here