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 (gnu packages base)
27 #:use-module (gnu packages bash)
28 #:use-module (gnu packages admin)
29 #:use-module (gnu packages package-management)
30 #:use-module (gnu services)
31 #:use-module (gnu services dmd)
32 #:use-module (gnu services base)
33 #:use-module (gnu system grub)
34 #:use-module (gnu system shadow)
35 #:use-module (gnu system linux)
36 #:use-module (gnu system linux-initrd)
37 #:use-module (gnu system file-systems)
38 #:use-module (ice-9 match)
39 #:use-module (srfi srfi-1)
40 #:use-module (srfi srfi-26)
41 #:export (operating-system
44 operating-system-bootloader
45 operating-system-services
46 operating-system-user-services
47 operating-system-packages
48 operating-system-host-name
49 operating-system-kernel
50 operating-system-initrd
51 operating-system-users
52 operating-system-groups
53 operating-system-packages
54 operating-system-timezone
55 operating-system-locale
56 operating-system-file-systems
58 operating-system-derivation
59 operating-system-profile
60 operating-system-grub.cfg))
64 ;;; This module supports whole-system configuration.
68 ;; System-wide configuration.
69 ;; TODO: Add per-field docstrings/stexi.
70 (define-record-type* <operating-system> operating-system
73 (kernel operating-system-kernel ; package
74 (default linux-libre))
75 (bootloader operating-system-bootloader) ; <grub-configuration>
77 (initrd operating-system-initrd ; (list fs) -> M derivation
78 (default qemu-initrd))
80 (host-name operating-system-host-name) ; string
82 (file-systems operating-system-file-systems ; list of fs
85 (users operating-system-users ; list of user accounts
87 (groups operating-system-groups ; list of user groups
88 (default (list (user-group
92 (skeletons operating-system-skeletons ; list of name/monadic value
93 (default (default-skeletons)))
95 (packages operating-system-packages ; list of (PACKAGE OUTPUT...)
96 (default (list coreutils ; or just PACKAGE
102 (@ (gnu packages dmd) dmd)
106 (timezone operating-system-timezone) ; string
107 (locale operating-system-locale) ; string
109 (services operating-system-user-services ; list of monadic services
110 (default %base-services))
112 (pam-services operating-system-pam-services ; list of PAM services
113 (default (base-pam-services)))
114 (setuid-programs operating-system-setuid-programs
115 (default %setuid-programs)) ; list of string-valued gexps
117 (sudoers operating-system-sudoers ; /etc/sudoers contents
118 (default %sudoers-specification)))
125 (define* (union inputs
126 #:key (guile (%guile-for-build)) (system (%current-system))
128 "Return a derivation that builds the union of INPUTS. INPUTS is a list of
132 (use-modules (guix build union))
134 (define inputs '#$inputs)
136 (setvbuf (current-output-port) _IOLBF)
137 (setvbuf (current-error-port) _IOLBF)
139 (format #t "building union `~a' with ~a packages...~%"
140 #$output (length inputs))
141 (union-build #$output inputs)))
143 (gexp->derivation name builder
145 #:modules '((guix build union))
146 #:guile-for-build guile
149 (define* (file-union name files)
150 "Return a derivation that builds a directory containing all of FILES. Each
151 item in FILES must be a list where the first element is the file name to use
152 in the new directory, and the second element is a gexp denoting the target
158 #$@(map (match-lambda
160 #~(symlink #$source #$target)))
163 (gexp->derivation name builder))
170 (define (other-file-system-services os)
171 "Return file system services for the file systems of OS that are not marked
172 as 'needed-for-boot'."
175 (or (file-system-needed-for-boot? fs)
176 (string=? "/" (file-system-mount-point fs))))
177 (operating-system-file-systems os)))
179 (sequence %store-monad
181 (($ <file-system> device target type flags opts #f check?)
182 (file-system-service device target type
187 (define (essential-services os)
188 "Return the list of essential services for OS. These are special services
189 that implement part of what's declared in OS are responsible for low-level
191 (mlet* %store-monad ((root-fs (root-file-system-service))
192 (other-fs (other-file-system-services os))
193 (procs (user-processes-service
194 (map (compose first service-provision)
196 (host-name (host-name-service
197 (operating-system-host-name os))))
198 (return (cons* host-name procs root-fs other-fs))))
200 (define (operating-system-services os)
201 "Return all the services of OS, including \"internal\" services that do not
202 explicitly appear in OS."
204 ((user (sequence %store-monad (operating-system-user-services os)))
205 (essential (essential-services os)))
206 (return (append essential user))))
213 (define* (etc-directory #:key
214 (locale "C") (timezone "Europe/Paris")
217 (profile "/run/current-system/profile")
219 "Return a derivation that builds the static part of the /etc directory."
221 ((pam.d (pam-services->directory pam-services))
222 (sudoers (text-file "sudoers" sudoers))
223 (login.defs (text-file "login.defs" "# Empty for now.\n"))
224 (shells (text-file "shells" ; used by xterm and others
227 /run/current-system/profile/bin/sh
228 /run/current-system/profile/bin/bash\n"))
229 (issue (text-file "issue" "
230 This is an alpha preview of the GNU system. Welcome.
232 This image features the GNU Guix package manager, which was used to
233 build it (http://www.gnu.org/software/guix/). The init system is
234 GNU dmd (http://www.gnu.org/software/dmd/).
236 You can log in as 'guest' or 'root' with no password.
239 ;; TODO: Generate bashrc from packages' search-paths.
240 (bashrc (text-file* "bashrc" "
241 export PS1='\\u@\\h\\$ '
243 export LC_ALL=\"" locale "\"
244 export TZ=\"" timezone "\"
245 export TZDIR=\"" tzdata "/share/zoneinfo\"
247 export PATH=/run/setuid-programs:/run/current-system/profile/sbin
248 export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH
249 export CPATH=$HOME/.guix-profile/include:" profile "/include
250 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
251 alias ls='ls -p --color'
254 (skel (skeleton-directory skeletons)))
256 `(("services" ,#~(string-append #$net-base "/etc/services"))
257 ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
258 ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
260 ("login.defs" ,#~#$login.defs)
263 ("shells" ,#~#$shells)
264 ("profile" ,#~#$bashrc)
265 ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
267 ("sudoers" ,#~#$sudoers)))))
269 (define (operating-system-profile os)
270 "Return a derivation that builds the default profile of OS."
271 ;; TODO: Replace with a real profile with a manifest.
272 (union (operating-system-packages os)
273 #:name "default-profile"))
275 (define %root-account
276 ;; Default root account.
280 (uid 0) (group "root")
281 (comment "System administrator")
282 (home-directory "/root")))
284 (define (operating-system-accounts os)
285 "Return the user accounts for OS, including an obligatory 'root' account."
287 ;; Make sure there's a root account.
288 (if (find (lambda (user)
289 (and=> (user-account-uid user) zero?))
290 (operating-system-users os))
291 (operating-system-users os)
292 (cons %root-account (operating-system-users os))))
294 (mlet %store-monad ((services (operating-system-services os)))
295 (return (append users
296 (append-map service-user-accounts services)))))
298 (define (operating-system-etc-directory os)
299 "Return that static part of the /etc directory of OS."
301 ((services (operating-system-services os))
303 ;; Services known to PAM.
305 (append (operating-system-pam-services os)
306 (append-map service-pam-services services))))
307 (profile-drv (operating-system-profile os))
308 (skeletons (operating-system-skeletons os)))
309 (etc-directory #:pam-services pam-services
310 #:skeletons skeletons
311 #:locale (operating-system-locale os)
312 #:timezone (operating-system-timezone os)
313 #:sudoers (operating-system-sudoers os)
314 #:profile profile-drv)))
316 (define %setuid-programs
317 ;; Default set of setuid-root programs.
318 (let ((shadow (@ (gnu packages admin) shadow)))
319 (list #~(string-append #$shadow "/bin/passwd")
320 #~(string-append #$shadow "/bin/su")
321 #~(string-append #$inetutils "/bin/ping")
322 #~(string-append #$sudo "/bin/sudo"))))
324 (define %sudoers-specification
325 ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
326 ;; group can do anything. See
327 ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
328 ;; TODO: Add a declarative API.
330 %wheel ALL=(ALL) ALL\n")
332 (define (user-group->gexp group)
333 "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
335 #~(list #$(user-group-name group)
336 #$(user-group-password group)
337 #$(user-group-id group)))
339 (define (user-account->gexp account)
340 "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
342 #~`(#$(user-account-name account)
343 #$(user-account-uid account)
344 #$(user-account-group account)
345 #$(user-account-supplementary-groups account)
346 #$(user-account-comment account)
347 #$(user-account-home-directory account)
348 ,#$(user-account-shell account) ; this one is a gexp
349 #$(user-account-password account)))
351 (define (operating-system-activation-script os)
352 "Return the activation script for OS---i.e., the code that \"activates\" the
353 stateful part of OS, including user accounts and groups, special directories,
356 '((guix build activation)
358 (guix build linux-initrd)))
360 (mlet* %store-monad ((services (operating-system-services os))
361 (etc (operating-system-etc-directory os))
362 (modules (imported-modules %modules))
363 (compiled (compiled-modules %modules))
364 (accounts (operating-system-accounts os)))
366 (operating-system-setuid-programs os))
369 (map user-account->gexp accounts))
372 (append (operating-system-groups os)
373 (append-map service-user-groups services)))
376 (map user-group->gexp groups))
380 (eval-when (expand load eval)
381 ;; Make sure 'use-modules' below succeeds.
382 (set! %load-path (cons #$modules %load-path))
383 (set! %load-compiled-path
384 (cons #$compiled %load-compiled-path)))
386 (use-modules (guix build activation))
391 ;; Add users and user groups.
393 (string-append #$(@ (gnu packages admin) shadow)
395 (activate-users+groups (list #$@user-specs)
396 (list #$@group-specs))
398 ;; Activate setuid programs.
399 (activate-setuid-programs (list #$@setuid-progs))
401 ;; Set up /run/current-system.
402 (activate-current-system)))))
404 (define (operating-system-boot-script os)
405 "Return the boot script for OS---i.e., the code started by the initrd once
406 we're running in the final root."
407 (mlet* %store-monad ((services (operating-system-services os))
408 (activate (operating-system-activation-script os))
409 (dmd-conf (dmd-configuration-file services)))
412 ;; Activate the system.
413 ;; TODO: Use 'load-compiled'.
414 (primitive-load #$activate)
416 ;; Keep track of the booted system.
417 (false-if-exception (delete-file "/run/booted-system"))
418 (symlink (readlink "/run/current-system")
419 "/run/booted-system")
421 ;; Close any remaining open file descriptors to be on the
422 ;; safe side. This must be the very last thing we do,
423 ;; because Guile has internal FDs such as 'sleep_pipe'
424 ;; that need to be alive.
427 (false-if-exception (close-fdes fd))
431 (execl (string-append #$dmd "/bin/dmd")
432 "dmd" "--config" #$dmd-conf)))))
434 (define (operating-system-root-file-system os)
435 "Return the root file system of OS."
437 (($ <file-system> _ "/") #t)
439 (operating-system-file-systems os)))
441 (define (operating-system-initrd-file os)
442 "Return a gexp denoting the initrd file of OS."
443 (define boot-file-systems
444 (filter (match-lambda
445 (($ <file-system> device "/")
447 (($ <file-system> device mount-point type flags options boot?)
449 (operating-system-file-systems os)))
452 ((initrd ((operating-system-initrd os) boot-file-systems)))
453 (return #~(string-append #$initrd "/initrd"))))
455 (define (operating-system-grub.cfg os)
456 "Return the GRUB configuration file for OS."
458 ((system (operating-system-derivation os))
459 (root-fs -> (operating-system-root-file-system os))
460 (kernel -> (operating-system-kernel os))
461 (entries -> (list (menu-entry
462 (label (string-append
464 (package-full-name kernel)
465 " (technology preview)"))
468 (list (string-append "--root="
469 (file-system-device root-fs))
470 #~(string-append "--system=" #$system)
471 #~(string-append "--load=" #$system
473 (initrd #~(string-append #$system "/initrd"))))))
474 (grub-configuration-file (operating-system-bootloader os) entries)))
476 (define (operating-system-derivation os)
477 "Return a derivation that builds OS."
479 ((profile (operating-system-profile os))
480 (etc (operating-system-etc-directory os))
481 (boot (operating-system-boot-script os))
482 (kernel -> (operating-system-kernel os))
483 (initrd (operating-system-initrd-file os)))
486 ("kernel" ,#~#$kernel)
488 ("profile" ,#~#$profile)
491 ;;; system.scm ends here