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