gnu/system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 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)
  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 (ice-9 match)
  38   #:use-module (srfi srfi-1)
  39   #:use-module (srfi srfi-26)
  40   #:export (operating-system
  41             operating-system?
  42             operating-system-services
  43             operating-system-packages
  44             operating-system-bootloader-entries
  45             operating-system-host-name
  46             operating-system-kernel
  47             operating-system-initrd
  48             operating-system-users
  49             operating-system-groups
  50             operating-system-packages
  51             operating-system-timezone
  52             operating-system-locale
  53             operating-system-services
  54             operating-system-file-systems
  55
  56             operating-system-derivation
  57             operating-system-profile
  58
  59             <file-system>
  60             file-system
  61             file-system?
  62             file-system-device
  63             file-system-mount-point
  64             file-system-type
  65             file-system-needed-for-boot?
  66             file-system-flags
  67             file-system-options))
  68
  69 ;;; Commentary:
  70 ;;;
  71 ;;; This module supports whole-system configuration.
  72 ;;;
  73 ;;; Code:
  74
  75 ;; System-wide configuration.
  76 ;; TODO: Add per-field docstrings/stexi.
  77 (define-record-type* <operating-system> operating-system
  78   make-operating-system
  79   operating-system?
  80   (kernel operating-system-kernel                 ; package
  81           (default linux-libre))
  82   (bootloader operating-system-bootloader         ; package
  83               (default grub))
  84   (bootloader-entries operating-system-bootloader-entries ; list
  85                       (default '()))
  86   (initrd operating-system-initrd                 ; (list fs) -> M derivation
  87           (default qemu-initrd))
  88
  89   (host-name operating-system-host-name)          ; string
  90
  91   (file-systems operating-system-file-systems     ; list of fs
  92                 (default '()))
  93
  94   (users operating-system-users                   ; list of user accounts
  95          (default '()))
  96   (groups operating-system-groups                 ; list of user groups
  97           (default (list (user-group
  98                           (name "root")
  99                           (id 0)))))
 100
 101   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
 102             (default (list coreutils              ; or just PACKAGE
 103                            grep
 104                            sed
 105                            findutils
 106                            guile
 107                            bash
 108                            (@ (gnu packages dmd) dmd)
 109                            guix
 110                            tzdata)))
 111
 112   (timezone operating-system-timezone)            ; string
 113   (locale   operating-system-locale)              ; string
 114
 115   (services operating-system-services             ; list of monadic services
 116             (default %base-services))
 117
 118   (pam-services operating-system-pam-services     ; list of PAM services
 119                 (default (base-pam-services)))
 120   (setuid-programs operating-system-setuid-programs
 121                    (default %setuid-programs))    ; list of string-valued gexps
 122
 123   (sudoers operating-system-sudoers               ; /etc/sudoers contents
 124            (default %sudoers-specification)))
 125
 126 ;; File system declaration.
 127 (define-record-type* <file-system> file-system
 128   make-file-system
 129   file-system?
 130   (device           file-system-device)           ; string
 131   (mount-point      file-system-mount-point)      ; string
 132   (type             file-system-type)             ; string
 133   (flags            file-system-flags             ; list of symbols
 134                     (default '()))
 135   (options          file-system-options           ; string or #f
 136                     (default #f))
 137   (needed-for-boot? file-system-needed-for-boot?  ; Boolean
 138                     (default #f))
 139   (check?           file-system-check?            ; Boolean
 140                     (default #t)))
 141
 142 \f
 143 ;;;
 144 ;;; Derivation.
 145 ;;;
 146
 147 (define* (union inputs
 148                 #:key (guile (%guile-for-build)) (system (%current-system))
 149                 (name "union"))
 150   "Return a derivation that builds the union of INPUTS.  INPUTS is a list of
 151 input tuples."
 152   (define builder
 153     #~(begin
 154         (use-modules (guix build union))
 155
 156         (define inputs '#$inputs)
 157
 158         (setvbuf (current-output-port) _IOLBF)
 159         (setvbuf (current-error-port) _IOLBF)
 160
 161         (format #t "building union `~a' with ~a packages...~%"
 162                 #$output (length inputs))
 163         (union-build #$output inputs)))
 164
 165   (gexp->derivation name builder
 166                     #:system system
 167                     #:modules '((guix build union))
 168                     #:guile-for-build guile
 169                     #:local-build? #t))
 170
 171 (define* (file-union name files)
 172   "Return a derivation that builds a directory containing all of FILES.  Each
 173 item in FILES must be a list where the first element is the file name to use
 174 in the new directory, and the second element is a gexp denoting the target
 175 file."
 176   (define builder
 177     #~(begin
 178         (mkdir #$output)
 179         (chdir #$output)
 180         #$@(map (match-lambda
 181                  ((target source)
 182                   #~(symlink #$source #$target)))
 183                 files)))
 184
 185   (gexp->derivation name builder))
 186
 187 (define* (etc-directory #:key
 188                         (locale "C") (timezone "Europe/Paris")
 189                         (accounts '())
 190                         (groups '())
 191                         (pam-services '())
 192                         (profile "/var/run/current-system/profile")
 193                         (sudoers ""))
 194   "Return a derivation that builds the static part of the /etc directory."
 195   (mlet* %store-monad
 196       ((passwd     (passwd-file accounts))
 197        (shadow     (passwd-file accounts #:shadow? #t))
 198        (group      (group-file groups))
 199        (pam.d      (pam-services->directory pam-services))
 200        (sudoers    (text-file "sudoers" sudoers))
 201        (login.defs (text-file "login.defs" "# Empty for now.\n"))
 202        (shells     (text-file "shells"            ; used by xterm and others
 203                               "\
 204 /bin/sh
 205 /run/current-system/bin/sh
 206 /run/current-system/bin/bash\n"))
 207        (issue      (text-file "issue" "
 208 This is an alpha preview of the GNU system.  Welcome.
 209
 210 This image features the GNU Guix package manager, which was used to
 211 build it (http://www.gnu.org/software/guix/).  The init system is
 212 GNU dmd (http://www.gnu.org/software/dmd/).
 213
 214 You can log in as 'guest' or 'root' with no password.
 215 "))
 216
 217        ;; TODO: Generate bashrc from packages' search-paths.
 218        (bashrc    (text-file* "bashrc"  "
 219 export PS1='\\u@\\h\\$ '
 220
 221 export LC_ALL=\"" locale "\"
 222 export TZ=\"" timezone "\"
 223 export TZDIR=\"" tzdata "/share/zoneinfo\"
 224
 225 export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin
 226 export PATH=/run/setuid-programs:$PATH
 227 export CPATH=$HOME/.guix-profile/include:" profile "/include
 228 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
 229 alias ls='ls -p --color'
 230 alias ll='ls -l'
 231 ")))
 232     (file-union "etc"
 233                 `(("services" ,#~(string-append #$net-base "/etc/services"))
 234                   ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
 235                   ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
 236                   ("pam.d" ,#~#$pam.d)
 237                   ("login.defs" ,#~#$login.defs)
 238                   ("issue" ,#~#$issue)
 239                   ("shells" ,#~#$shells)
 240                   ("profile" ,#~#$bashrc)
 241                   ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
 242                                                  #$timezone))
 243                   ("passwd" ,#~#$passwd)
 244                   ("shadow" ,#~#$shadow)
 245                   ("group" ,#~#$group)
 246
 247                   ("sudoers" ,#~#$sudoers)))))
 248
 249 (define (operating-system-profile os)
 250   "Return a derivation that builds the default profile of OS."
 251   ;; TODO: Replace with a real profile with a manifest.
 252   (union (operating-system-packages os)
 253          #:name "default-profile"))
 254
 255 (define (operating-system-accounts os)
 256   "Return the user accounts for OS, including an obligatory 'root' account."
 257   (mlet %store-monad ((services (sequence %store-monad
 258                                           (operating-system-services os))))
 259     (return (cons (user-account
 260                    (name "root")
 261                    (password "")
 262                    (uid 0) (gid 0)
 263                    (comment "System administrator")
 264                    (home-directory "/root"))
 265                   (append (operating-system-users os)
 266                           (append-map service-user-accounts
 267                                       services))))))
 268
 269 (define (operating-system-etc-directory os)
 270   "Return that static part of the /etc directory of OS."
 271   (mlet* %store-monad
 272       ((services     (sequence %store-monad (operating-system-services os)))
 273        (pam-services ->
 274                      ;; Services known to PAM.
 275                      (delete-duplicates
 276                       (append (operating-system-pam-services os)
 277                               (append-map service-pam-services services))))
 278        (accounts    (operating-system-accounts os))
 279        (profile-drv (operating-system-profile os))
 280        (groups   -> (append (operating-system-groups os)
 281                             (append-map service-user-groups services))))
 282    (etc-directory #:accounts accounts #:groups groups
 283                   #:pam-services pam-services
 284                   #:locale (operating-system-locale os)
 285                   #:timezone (operating-system-timezone os)
 286                   #:sudoers (operating-system-sudoers os)
 287                   #:profile profile-drv)))
 288
 289 (define %setuid-programs
 290   ;; Default set of setuid-root programs.
 291   (let ((shadow (@ (gnu packages admin) shadow)))
 292     (list #~(string-append #$shadow "/bin/passwd")
 293           #~(string-append #$shadow "/bin/su")
 294           #~(string-append #$inetutils "/bin/ping")
 295           #~(string-append #$sudo "/bin/sudo"))))
 296
 297 (define %sudoers-specification
 298   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
 299   ;; group can do anything.  See
 300   ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
 301   ;; TODO: Add a declarative API.
 302   "root ALL=(ALL) ALL
 303 %wheel ALL=(ALL) ALL\n")
 304
 305 (define (operating-system-boot-script os)
 306   "Return the boot script for OS---i.e., the code started by the initrd once
 307 we're running in the final root."
 308   (define %modules
 309     '((guix build activation)
 310       (guix build utils)))
 311
 312   (mlet* %store-monad
 313       ((services (sequence %store-monad (operating-system-services os)))
 314        (etc      (operating-system-etc-directory os))
 315        (modules  (imported-modules %modules))
 316        (compiled (compiled-modules %modules))
 317        (dmd-conf (dmd-configuration-file services)))
 318     (define setuid-progs
 319       (operating-system-setuid-programs os))
 320
 321     (gexp->file "boot"
 322                 #~(begin
 323                     (eval-when (expand load eval)
 324                       ;; Make sure 'use-modules' below succeeds.
 325                       (set! %load-path (cons #$modules %load-path))
 326                       (set! %load-compiled-path
 327                             (cons #$compiled %load-compiled-path)))
 328
 329                     (use-modules (guix build activation))
 330
 331                     ;; Populate /etc.
 332                     (activate-etc #$etc)
 333
 334                     ;; Activate setuid programs.
 335                     (activate-setuid-programs (list #$@setuid-progs))
 336
 337                     ;; Start dmd.
 338                     (execl (string-append #$dmd "/bin/dmd")
 339                            "dmd" "--config" #$dmd-conf)))))
 340
 341 (define (operating-system-root-file-system os)
 342   "Return the root file system of OS."
 343   (find (match-lambda
 344          (($ <file-system> _ "/") #t)
 345          (_ #f))
 346         (operating-system-file-systems os)))
 347
 348 (define (operating-system-derivation os)
 349   "Return a derivation that builds OS."
 350   (define boot-file-systems
 351     (filter (match-lambda
 352              (($ <file-system> device mount-point type _ _ boot?)
 353               (and boot? (not (string=? mount-point "/")))))
 354             (operating-system-file-systems os)))
 355
 356   (mlet* %store-monad
 357       ((profile     (operating-system-profile os))
 358        (etc         (operating-system-etc-directory os))
 359        (services    (sequence %store-monad (operating-system-services os)))
 360        (boot        (operating-system-boot-script os))
 361        (kernel  ->  (operating-system-kernel os))
 362        (initrd      ((operating-system-initrd os) boot-file-systems))
 363        (initrd-file -> #~(string-append #$initrd "/initrd"))
 364        (root-fs ->  (operating-system-root-file-system os))
 365        (entries ->  (list (menu-entry
 366                            (label (string-append
 367                                    "GNU system with "
 368                                    (package-full-name kernel)
 369                                    " (technology preview)"))
 370                            (linux kernel)
 371                            (linux-arguments
 372                             (list (string-append "--root="
 373                                                  (file-system-device root-fs))
 374                                   #~(string-append "--load=" #$boot)))
 375                            (initrd initrd-file))))
 376        (grub.cfg (grub-configuration-file entries)))
 377     (file-union "system"
 378                 `(("boot" ,#~#$boot)
 379                   ("kernel" ,#~#$kernel)
 380                   ("initrd" ,initrd-file)
 381                   ("profile" ,#~#$profile)
 382                   ("grub.cfg" ,#~#$grub.cfg)
 383                   ("etc" ,#~#$etc)))))
 384
 385 ;;; system.scm ends here