gnu/system.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
   4 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
   5 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
   6 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   7 ;;;
   8 ;;; This file is part of GNU Guix.
   9 ;;;
  10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  11 ;;; under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 3 of the License, or (at
  13 ;;; your option) any later version.
  14 ;;;
  15 ;;; GNU Guix is distributed in the hope that it will be useful, but
  16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 (define-module (gnu system)
  24   #:use-module (guix store)
  25   #:use-module (guix monads)
  26   #:use-module (guix gexp)
  27   #:use-module (guix records)
  28   #:use-module (guix packages)
  29   #:use-module (guix derivations)
  30   #:use-module (guix profiles)
  31   #:use-module (guix ui)
  32   #:use-module (gnu packages base)
  33   #:use-module (gnu packages bash)
  34   #:use-module (gnu packages guile)
  35   #:use-module (gnu packages admin)
  36   #:use-module (gnu packages linux)
  37   #:use-module (gnu packages pciutils)
  38   #:use-module (gnu packages package-management)
  39   #:use-module (gnu packages less)
  40   #:use-module (gnu packages zile)
  41   #:use-module (gnu packages nano)
  42   #:use-module (gnu packages lsof)
  43   #:use-module (gnu packages gawk)
  44   #:use-module (gnu packages man)
  45   #:use-module (gnu packages texinfo)
  46   #:use-module (gnu packages compression)
  47   #:use-module (gnu packages firmware)
  48   #:use-module (gnu services)
  49   #:use-module (gnu services shepherd)
  50   #:use-module (gnu services base)
  51   #:use-module (gnu bootloader)
  52   #:use-module (gnu system shadow)
  53   #:use-module (gnu system nss)
  54   #:use-module (gnu system locale)
  55   #:use-module (gnu system pam)
  56   #:use-module (gnu system linux-initrd)
  57   #:use-module (gnu system file-systems)
  58   #:use-module (gnu system mapped-devices)
  59   #:use-module (ice-9 match)
  60   #:use-module (srfi srfi-1)
  61   #:use-module (srfi srfi-26)
  62   #:use-module (srfi srfi-34)
  63   #:use-module (srfi srfi-35)
  64   #:use-module (rnrs bytevectors)
  65   #:export (operating-system
  66             operating-system?
  67
  68             operating-system-bootloader
  69             operating-system-services
  70             operating-system-user-services
  71             operating-system-packages
  72             operating-system-host-name
  73             operating-system-hosts-file
  74             operating-system-kernel
  75             operating-system-kernel-file
  76             operating-system-kernel-arguments
  77             operating-system-initrd
  78             operating-system-users
  79             operating-system-groups
  80             operating-system-issue
  81             operating-system-timezone
  82             operating-system-locale
  83             operating-system-locale-definitions
  84             operating-system-locale-libcs
  85             operating-system-mapped-devices
  86             operating-system-file-systems
  87             operating-system-store-file-system
  88             operating-system-user-mapped-devices
  89             operating-system-boot-mapped-devices
  90             operating-system-activation-script
  91             operating-system-user-accounts
  92             operating-system-shepherd-service-names
  93
  94             operating-system-derivation
  95             operating-system-profile
  96             operating-system-bootcfg
  97             operating-system-etc-directory
  98             operating-system-locale-directory
  99             operating-system-boot-script
 100
 101             system-linux-image-file-name
 102
 103             boot-parameters
 104             boot-parameters?
 105             boot-parameters-label
 106             boot-parameters-root-device
 107             boot-parameters-bootloader-name
 108             boot-parameters-store-device
 109             boot-parameters-store-mount-point
 110             boot-parameters-kernel
 111             boot-parameters-kernel-arguments
 112             boot-parameters-initrd
 113             read-boot-parameters
 114             read-boot-parameters-file
 115             boot-parameters->menu-entry
 116
 117             local-host-aliases
 118             %setuid-programs
 119             %base-packages
 120             %base-firmware))
 121
 122 ;;; Commentary:
 123 ;;;
 124 ;;; This module supports whole-system configuration.
 125 ;;;
 126 ;;; Code:
 127
 128 (define (bootable-kernel-arguments kernel-arguments system.drv root-device)
 129   "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
 130 booted from ROOT-DEVICE"
 131   (cons* (string-append "--root=" root-device)
 132          #~(string-append "--system=" #$system.drv)
 133          #~(string-append "--load=" #$system.drv "/boot")
 134          kernel-arguments))
 135
 136 ;; System-wide configuration.
 137 ;; TODO: Add per-field docstrings/stexi.
 138 (define-record-type* <operating-system> operating-system
 139   make-operating-system
 140   operating-system?
 141   (kernel operating-system-kernel                 ; package
 142           (default linux-libre))
 143   (kernel-arguments operating-system-user-kernel-arguments
 144                     (default '()))                ; list of gexps/strings
 145   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
 146
 147   (initrd operating-system-initrd                 ; (list fs) -> M derivation
 148           (default base-initrd))
 149   (firmware operating-system-firmware             ; list of packages
 150             (default %base-firmware))
 151
 152   (host-name operating-system-host-name)          ; string
 153   (hosts-file operating-system-hosts-file         ; file-like | #f
 154               (default #f))
 155
 156   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
 157                   (default '()))
 158   (file-systems operating-system-file-systems)    ; list of fs
 159   (swap-devices operating-system-swap-devices     ; list of strings
 160                 (default '()))
 161
 162   (users operating-system-users                   ; list of user accounts
 163          (default %base-user-accounts))
 164   (groups operating-system-groups                 ; list of user groups
 165           (default %base-groups))
 166
 167   (skeletons operating-system-skeletons           ; list of name/monadic value
 168              (default (default-skeletons)))
 169   (issue operating-system-issue                   ; string
 170          (default %default-issue))
 171
 172   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
 173             (default %base-packages))             ; or just PACKAGE
 174
 175   (timezone operating-system-timezone)            ; string
 176   (locale   operating-system-locale               ; string
 177             (default "en_US.utf8"))
 178   (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
 179                       (default %default-locale-definitions))
 180   (locale-libcs operating-system-locale-libcs     ; list of <packages>
 181                 (default %default-locale-libcs))
 182   (name-service-switch operating-system-name-service-switch ; <name-service-switch>
 183                        (default %default-nss))
 184
 185   (services operating-system-user-services        ; list of monadic services
 186             (default %base-services))
 187
 188   (pam-services operating-system-pam-services     ; list of PAM services
 189                 (default (base-pam-services)))
 190   (setuid-programs operating-system-setuid-programs
 191                    (default %setuid-programs))    ; list of string-valued gexps
 192
 193   (sudoers-file operating-system-sudoers-file     ; file-like
 194                 (default %sudoers-specification)))
 195
 196 (define (operating-system-kernel-arguments os system.drv root-device)
 197   "Return all the kernel arguments, including the ones not specified
 198 directly by the user."
 199   (bootable-kernel-arguments (operating-system-user-kernel-arguments os)
 200                              system.drv
 201                              root-device))
 202
 203 \f
 204 ;;;
 205 ;;; Boot parameters
 206 ;;;
 207
 208 (define-record-type* <boot-parameters>
 209   boot-parameters make-boot-parameters boot-parameters?
 210   (label            boot-parameters-label)
 211   ;; Because we will use the 'store-device' to create the GRUB search command,
 212   ;; the 'store-device' has slightly different semantics than 'root-device'.
 213   ;; The 'store-device' can be a file system uuid, a file system label, or #f,
 214   ;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
 215   ;; understand that.  The 'root-device', on the other hand, corresponds
 216   ;; exactly to the device field of the <file-system> object representing the
 217   ;; OS's root file system, so it might be a device path like "/dev/sda3".
 218   (root-device      boot-parameters-root-device)
 219   (bootloader-name  boot-parameters-bootloader-name)
 220   (store-device     boot-parameters-store-device)
 221   (store-mount-point boot-parameters-store-mount-point)
 222   (kernel           boot-parameters-kernel)
 223   (kernel-arguments boot-parameters-kernel-arguments)
 224   (initrd           boot-parameters-initrd))
 225
 226 (define (read-boot-parameters port)
 227   "Read boot parameters from PORT and return the corresponding
 228 <boot-parameters> object or #f if the format is unrecognized."
 229   (match (read port)
 230     (('boot-parameters ('version 0)
 231                        ('label label) ('root-device root)
 232                        ('kernel linux)
 233                        rest ...)
 234      (boot-parameters
 235       (label label)
 236       (root-device root)
 237
 238       (bootloader-name
 239        (match (assq 'bootloader-name rest)
 240          ((_ args) args)
 241          (#f       'grub))) ; for compatibility reasons.
 242
 243       ;; In the past, we would store the directory name of the kernel instead
 244       ;; of the absolute file name of its image.  Detect that and correct it.
 245       (kernel (if (string=? linux (direct-store-path linux))
 246                   (string-append linux "/"
 247                                  (system-linux-image-file-name))
 248                   linux))
 249
 250       (kernel-arguments
 251        (match (assq 'kernel-arguments rest)
 252          ((_ args) args)
 253          (#f       '())))                         ;the old format
 254
 255       (initrd
 256        (match (assq 'initrd rest)
 257          (('initrd ('string-append directory file)) ;the old format
 258           (string-append directory file))
 259          (('initrd (? string? file))
 260           file)))
 261
 262       (store-device
 263        (match (assq 'store rest)
 264          (('store ('device device) _ ...)
 265           device)
 266          (_                                       ;the old format
 267           ;; Root might be a device path like "/dev/sda1", which is not a
 268           ;; suitable GRUB device identifier.
 269           (if (string-prefix? "/" root)
 270               #f
 271               root))))
 272
 273       (store-mount-point
 274        (match (assq 'store rest)
 275          (('store ('device _) ('mount-point mount-point) _ ...)
 276           mount-point)
 277          (_                                       ;the old format
 278           "/")))))
 279     (x                                            ;unsupported format
 280      (warning (G_ "unrecognized boot parameters for '~a'~%")
 281               system)
 282      #f)))
 283
 284 (define (read-boot-parameters-file system)
 285   "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
 286 file and returns the corresponding <boot-parameters> object or #f if the
 287 format is unrecognized.
 288 The object has its kernel-arguments extended in order to make it bootable."
 289   (let* ((file (string-append system "/parameters"))
 290          (params (call-with-input-file file read-boot-parameters))
 291          (root (boot-parameters-root-device params))
 292          (root-device (if (bytevector? root)
 293                           (uuid->string root)
 294                           root))
 295          (kernel-arguments (boot-parameters-kernel-arguments params)))
 296     (if params
 297       (boot-parameters
 298         (inherit params)
 299         (kernel-arguments (bootable-kernel-arguments kernel-arguments
 300                                                      system
 301                                                      root-device)))
 302       #f)))
 303
 304 (define (boot-parameters->menu-entry conf)
 305   (menu-entry
 306    (label (boot-parameters-label conf))
 307    (device (boot-parameters-store-device conf))
 308    (device-mount-point (boot-parameters-store-mount-point conf))
 309    (linux (boot-parameters-kernel conf))
 310    (linux-arguments (boot-parameters-kernel-arguments conf))
 311    (initrd (boot-parameters-initrd conf))))
 312
 313
 314 \f
 315 ;;;
 316 ;;; Services.
 317 ;;;
 318
 319 (define (non-boot-file-system-service os)
 320   "Return the file system service for the file systems of OS that are not
 321 marked as 'needed-for-boot'."
 322   (define file-systems
 323     (remove file-system-needed-for-boot?
 324             (operating-system-file-systems os)))
 325
 326   (define (device-mappings fs)
 327     (let ((device (file-system-device fs)))
 328       (if (string? device)                        ;title is 'device
 329           (filter (lambda (md)
 330                     (string=? (string-append "/dev/mapper/"
 331                                              (mapped-device-target md))
 332                               device))
 333                   (operating-system-mapped-devices os))
 334           '())))
 335
 336   (define (add-dependencies fs)
 337     ;; Add the dependencies due to device mappings to FS.
 338     (file-system
 339       (inherit fs)
 340       (dependencies
 341        (delete-duplicates (append (device-mappings fs)
 342                                   (file-system-dependencies fs))
 343                           eq?))))
 344
 345   (service file-system-service-type
 346            (map add-dependencies file-systems)))
 347
 348 (define (mapped-device-user device file-systems)
 349   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
 350   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
 351     (find (lambda (fs)
 352             (or (member device (file-system-dependencies fs))
 353                 (and (eq? 'device (file-system-title fs))
 354                      (string=? (file-system-device fs) target))))
 355           file-systems)))
 356
 357 (define (operating-system-user-mapped-devices os)
 358   "Return the subset of mapped devices that can be installed in
 359 user-land--i.e., those not needed during boot."
 360   (let ((devices      (operating-system-mapped-devices os))
 361         (file-systems (operating-system-file-systems os)))
 362    (filter (lambda (md)
 363              (let ((user (mapped-device-user md file-systems)))
 364                (or (not user)
 365                    (not (file-system-needed-for-boot? user)))))
 366            devices)))
 367
 368 (define (operating-system-boot-mapped-devices os)
 369   "Return the subset of mapped devices that must be installed during boot,
 370 from the initrd."
 371   (let ((devices      (operating-system-mapped-devices os))
 372         (file-systems (operating-system-file-systems os)))
 373    (filter (lambda (md)
 374              (let ((user (mapped-device-user md file-systems)))
 375                (and user (file-system-needed-for-boot? user))))
 376            devices)))
 377
 378 (define (device-mapping-services os)
 379   "Return the list of device-mapping services for OS as a list."
 380   (map device-mapping-service
 381        (operating-system-user-mapped-devices os)))
 382
 383 (define (swap-services os)
 384   "Return the list of swap services for OS."
 385   (map swap-service (operating-system-swap-devices os)))
 386
 387 (define* (system-linux-image-file-name #:optional (system (%current-system)))
 388   "Return the basename of the kernel image file for SYSTEM."
 389   ;; FIXME: Evaluate the conditional based on the actual current system.
 390   (cond
 391    ((string-prefix? "arm" (%current-system)) "zImage")
 392    ((string-prefix? "mips" (%current-system)) "vmlinuz")
 393    ((string-prefix? "aarch64" (%current-system)) "Image")
 394    (else "bzImage")))
 395
 396 (define (operating-system-kernel-file os)
 397   "Return an object representing the absolute file name of the kernel image of
 398 OS."
 399   (file-append (operating-system-kernel os)
 400                "/" (system-linux-image-file-name os)))
 401
 402 (define* (operating-system-directory-base-entries os #:key container?)
 403   "Return the basic entries of the 'system' directory of OS for use as the
 404 value of the SYSTEM-SERVICE-TYPE service."
 405   (let ((locale (operating-system-locale-directory os)))
 406     (with-monad %store-monad
 407       (if container?
 408           (return `(("locale" ,locale)))
 409           (mlet %store-monad
 410               ((kernel  ->  (operating-system-kernel os))
 411                (initrd      (operating-system-initrd-file os))
 412                (params      (operating-system-boot-parameters-file os)))
 413             (return `(("kernel" ,kernel)
 414                       ("parameters" ,params)
 415                       ("initrd" ,initrd)
 416                       ("locale" ,locale))))))))   ;used by libc
 417
 418 (define* (essential-services os #:key container?)
 419   "Return the list of essential services for OS.  These are special services
 420 that implement part of what's declared in OS are responsible for low-level
 421 bookkeeping.  CONTAINER? determines whether to return the list of services for
 422 a container or that of a \"bare metal\" system."
 423   (define known-fs
 424     (map file-system-mount-point (operating-system-file-systems os)))
 425
 426   (let* ((mappings  (device-mapping-services os))
 427          (root-fs   (root-file-system-service))
 428          (other-fs  (non-boot-file-system-service os))
 429          (unmount   (user-unmount-service known-fs))
 430          (swaps     (swap-services os))
 431          (procs     (user-processes-service))
 432          (host-name (host-name-service (operating-system-host-name os)))
 433          (entries   (operating-system-directory-base-entries
 434                      os #:container? container?)))
 435     (cons* (service system-service-type entries)
 436            %boot-service
 437
 438            ;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
 439            ;; execs shepherd comes last in the boot script (XXX).  Likewise,
 440            ;; the cleanup service must come last so that its gexp runs before
 441            ;; activation code.
 442            %shepherd-root-service
 443            %activation-service
 444            (service cleanup-service-type #f)
 445
 446            (pam-root-service (operating-system-pam-services os))
 447            (account-service (append (operating-system-accounts os)
 448                                     (operating-system-groups os))
 449                             (operating-system-skeletons os))
 450            (operating-system-etc-service os)
 451            (service fstab-service-type '())
 452            (session-environment-service
 453             (operating-system-environment-variables os))
 454            host-name procs root-fs unmount
 455            (service setuid-program-service-type
 456                     (operating-system-setuid-programs os))
 457            (service profile-service-type
 458                     (operating-system-packages os))
 459            other-fs
 460            (append mappings swaps
 461
 462                    ;; Add the firmware service, unless we are building for a
 463                    ;; container.
 464                    (if container?
 465                        '()
 466                        (list %linux-bare-metal-service
 467                              (service firmware-service-type
 468                                       (operating-system-firmware os))))))))
 469
 470 (define* (operating-system-services os #:key container?)
 471   "Return all the services of OS, including \"internal\" services that do not
 472 explicitly appear in OS."
 473   (append (operating-system-user-services os)
 474           (essential-services os #:container? container?)))
 475
 476 \f
 477 ;;;
 478 ;;; /etc.
 479 ;;;
 480
 481 (define %base-firmware
 482   ;; Firmware usable by default.
 483   (list ath9k-htc-firmware
 484         openfwwf-firmware))
 485
 486 (define %base-packages
 487   ;; Default set of packages globally visible.  It should include anything
 488   ;; required for basic administrator tasks.
 489   (cons* procps psmisc which less zile nano
 490          lsof                                 ;for Guix's 'list-runtime-roots'
 491          pciutils usbutils
 492          util-linux inetutils isc-dhcp
 493          (@ (gnu packages admin) shadow)          ;for 'passwd'
 494
 495          ;; wireless-tools is deprecated in favor of iw, but it's still what
 496          ;; many people are familiar with, so keep it around.
 497          iw wireless-tools rfkill
 498
 499          iproute
 500          net-tools                        ; XXX: remove when Inetutils suffices
 501          man-db
 502          info-reader                     ;the standalone Info reader (no Perl)
 503
 504          ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
 505          ;; want the other commands and the man pages (notably because
 506          ;; auto-completion in Emacs shell relies on man pages.)
 507          sudo
 508
 509          ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
 510          ;; already depends on it anyway.
 511          kmod eudev
 512
 513          e2fsprogs kbd
 514
 515          bash-completion
 516
 517          ;; XXX: We don't use (canonical-package guile-2.2) here because that
 518          ;; would create a collision in the global profile between the GMP
 519          ;; variant propagated by 'guile-final' and the GMP variant propagated
 520          ;; by 'gnutls', itself propagated by 'guix'.
 521          guile-2.2
 522
 523          ;; The packages below are also in %FINAL-INPUTS, so take them from
 524          ;; there to avoid duplication.
 525          (map canonical-package
 526               (list bash coreutils findutils grep sed
 527                     diffutils patch gawk tar gzip bzip2 xz lzip))))
 528
 529 (define %default-issue
 530   ;; Default contents for /etc/issue.
 531   "
 532 This is the GNU system.  Welcome.\n")
 533
 534 (define (local-host-aliases host-name)
 535   "Return aliases for HOST-NAME, to be used in /etc/hosts."
 536   (string-append "127.0.0.1 localhost " host-name "\n"
 537                  "::1       localhost " host-name "\n"))
 538
 539 (define (default-/etc/hosts host-name)
 540   "Return the default /etc/hosts file."
 541   (plain-file "hosts" (local-host-aliases host-name)))
 542
 543 (define* (operating-system-etc-service os)
 544   "Return a <service> that builds containing the static part of the /etc
 545 directory."
 546   (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
 547
 548         (issue      (plain-file "issue" (operating-system-issue os)))
 549         (nsswitch   (plain-file "nsswitch.conf"
 550                                 (name-service-switch->string
 551                                  (operating-system-name-service-switch os))))
 552
 553         ;; Startup file for POSIX-compliant login shells, which set system-wide
 554         ;; environment variables.
 555         (profile    (mixed-text-file "profile"  "\
 556 # Crucial variables that could be missing in the profiles' 'etc/profile'
 557 # because they would require combining both profiles.
 558 # FIXME: See <http://bugs.gnu.org/20255>.
 559 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
 560 export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
 561 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
 562 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
 563
 564 # Ignore the default value of 'PATH'.
 565 unset PATH
 566
 567 # Load the system profile's settings.
 568 GUIX_PROFILE=/run/current-system/profile \\
 569 . /run/current-system/profile/etc/profile
 570
 571 # Prepend setuid programs.
 572 export PATH=/run/setuid-programs:$PATH
 573
 574 # Since 'lshd' does not use pam_env, /etc/environment must be explicitly
 575 # loaded when someone logs in via SSH.  See <http://bugs.gnu.org/22175>.
 576 # We need 'PATH' to be defined here, for 'cat' and 'cut'.  Do this before
 577 # reading the user's 'etc/profile' to allow variables to be overridden.
 578 if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
 579      -a -z \"$LINUX_MODULE_DIRECTORY\" ]
 580 then
 581   . /etc/environment
 582   export `cat /etc/environment | cut -d= -f1`
 583 fi
 584
 585 if [ -f \"$HOME/.guix-profile/etc/profile\" ]
 586 then
 587   # Load the user profile's settings.
 588   GUIX_PROFILE=\"$HOME/.guix-profile\" \\
 589   . \"$HOME/.guix-profile/etc/profile\"
 590 else
 591   # At least define this one so that basic things just work
 592   # when the user installs their first package.
 593   export PATH=\"$HOME/.guix-profile/bin:$PATH\"
 594 fi
 595
 596 # Set the umask, notably for users logging in via 'lsh'.
 597 # See <http://bugs.gnu.org/22650>.
 598 umask 022
 599
 600 # Allow GStreamer-based applications to find plugins.
 601 export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
 602
 603 if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
 604 then
 605   # Load Bash-specific initialization code.
 606   . /etc/bashrc
 607 fi
 608 "))
 609
 610         (bashrc    (plain-file "bashrc" "\
 611 # Bash-specific initialization.
 612
 613 # The 'bash-completion' package.
 614 if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
 615 then
 616   # Bash-completion sources ~/.bash_completion.  It installs a dynamic
 617   # completion loader that searches its own completion files as well
 618   # as those in ~/.guix-profile and /run/current-system/profile.
 619   source /run/current-system/profile/etc/profile.d/bash_completion.sh
 620 fi\n")))
 621     (etc-service
 622      `(("services" ,(file-append net-base "/etc/services"))
 623        ("protocols" ,(file-append net-base "/etc/protocols"))
 624        ("rpc" ,(file-append net-base "/etc/rpc"))
 625        ("login.defs" ,#~#$login.defs)
 626        ("issue" ,#~#$issue)
 627        ("nsswitch.conf" ,#~#$nsswitch)
 628        ("profile" ,#~#$profile)
 629        ("bashrc" ,#~#$bashrc)
 630        ("hosts" ,#~#$(or (operating-system-hosts-file os)
 631                          (default-/etc/hosts (operating-system-host-name os))))
 632        ("localtime" ,(file-append tzdata "/share/zoneinfo/"
 633                                   (operating-system-timezone os)))
 634        ("sudoers" ,(operating-system-sudoers-file os))))))
 635
 636 (define %root-account
 637   ;; Default root account.
 638   (user-account
 639    (name "root")
 640    (password "")
 641    (uid 0) (group "root")
 642    (comment "System administrator")
 643    (home-directory "/root")))
 644
 645 (define (operating-system-accounts os)
 646   "Return the user accounts for OS, including an obligatory 'root' account,
 647 and excluding accounts requested by services."
 648   ;; Make sure there's a root account.
 649   (if (find (lambda (user)
 650               (and=> (user-account-uid user) zero?))
 651             (operating-system-users os))
 652       (operating-system-users os)
 653       (cons %root-account (operating-system-users os))))
 654
 655 (define (maybe-string->file file-name thing)
 656   "If THING is a string, return a <plain-file> with THING as its content.
 657 Otherwise just return THING.
 658
 659 This is for backward-compatibility of fields that used to be strings and are
 660 now file-like objects.."
 661   (match thing
 662     ((? string?)
 663      (warning (G_ "using a string for file '~a' is deprecated; \
 664 use 'plain-file' instead~%")
 665               file-name)
 666      (plain-file file-name thing))
 667     (x
 668      x)))
 669
 670 (define (maybe-file->monadic file-name thing)
 671   "If THING is a value in %STORE-MONAD, return it as is; otherwise return
 672 THING in the %STORE-MONAD.
 673
 674 This is for backward-compatibility of fields that used to be monadic values
 675 and are now file-like objects."
 676   (with-monad %store-monad
 677     (match thing
 678       ((? procedure?)
 679        (warning (G_ "using a monadic value for '~a' is deprecated; \
 680 use 'plain-file' instead~%")
 681                 file-name)
 682        thing)
 683       (x
 684        (return x)))))
 685
 686 (define (operating-system-etc-directory os)
 687   "Return that static part of the /etc directory of OS."
 688   (etc-directory
 689    (fold-services (operating-system-services os)
 690                   #:target-type etc-service-type)))
 691
 692 (define (operating-system-environment-variables os)
 693   "Return the environment variables of OS for
 694 @var{session-environment-service-type}, to be used in @file{/etc/environment}."
 695   `(("LANG" . ,(operating-system-locale os))
 696     ("TZ" . ,(operating-system-timezone os))
 697     ("TZDIR" . ,(file-append tzdata "/share/zoneinfo"))
 698     ;; Tell 'modprobe' & co. where to look for modules.
 699     ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
 700     ;; These variables are honored by OpenSSL (libssl) and Git.
 701     ("SSL_CERT_DIR" . "/etc/ssl/certs")
 702     ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
 703     ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
 704
 705     ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are
 706     ;; searched for.
 707     ("GTK_DATA_PREFIX" . "/run/current-system/profile")
 708
 709     ;; By default, applications that use D-Bus, such as Emacs, abort at startup
 710     ;; when /etc/machine-id is missing.  Make sure these warnings are non-fatal.
 711     ("DBUS_FATAL_WARNINGS" . "0")
 712
 713     ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package
 714     ;; used to look things up in 'PREFIX/lib/locale' instead of
 715     ;; '/run/current-system/locale' as was intended.  Keep this hack around so
 716     ;; that people who still have glibc@2.23-using packages in their profiles
 717     ;; can use them correctly.
 718     ;; TODO: Remove when glibc@2.23 is long gone.
 719     ("GUIX_LOCPATH" . "/run/current-system/locale")))
 720
 721 (define %setuid-programs
 722   ;; Default set of setuid-root programs.
 723   (let ((shadow (@ (gnu packages admin) shadow)))
 724     (list (file-append shadow "/bin/passwd")
 725           (file-append shadow "/bin/su")
 726           (file-append shadow "/bin/newuidmap")
 727           (file-append shadow "/bin/newgidmap")
 728           (file-append inetutils "/bin/ping")
 729           (file-append inetutils "/bin/ping6")
 730           (file-append sudo "/bin/sudo")
 731           (file-append fuse "/bin/fusermount"))))
 732
 733 (define %sudoers-specification
 734   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
 735   ;; group can do anything.  See
 736   ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
 737   ;; TODO: Add a declarative API.
 738   (plain-file "sudoers" "\
 739 root ALL=(ALL) ALL
 740 %wheel ALL=(ALL) ALL\n"))
 741
 742 (define* (operating-system-activation-script os #:key container?)
 743   "Return the activation script for OS---i.e., the code that \"activates\" the
 744 stateful part of OS, including user accounts and groups, special directories,
 745 etc."
 746   (let* ((services   (operating-system-services os #:container? container?))
 747          (activation (fold-services services
 748                                     #:target-type activation-service-type)))
 749     (activation-service->script activation)))
 750
 751 (define* (operating-system-boot-script os #:key container?)
 752   "Return the boot script for OS---i.e., the code started by the initrd once
 753 we're running in the final root.  When CONTAINER? is true, skip all
 754 hardware-related operations as necessary when booting a Linux container."
 755   (let* ((services (operating-system-services os #:container? container?))
 756          (boot     (fold-services services #:target-type boot-service-type)))
 757     ;; BOOT is the script as a monadic value.
 758     (service-value boot)))
 759
 760 (define (operating-system-user-accounts os)
 761   "Return the list of user accounts of OS."
 762   (let* ((services (operating-system-services os))
 763          (account  (fold-services services
 764                                   #:target-type account-service-type)))
 765     (filter user-account?
 766             (service-value account))))
 767
 768 (define (operating-system-shepherd-service-names os)
 769   "Return the list of Shepherd service names for OS."
 770   (append-map shepherd-service-provision
 771               (service-value
 772                (fold-services (operating-system-services os)
 773                               #:target-type
 774                               shepherd-root-service-type))))
 775
 776 (define* (operating-system-derivation os #:key container?)
 777   "Return a derivation that builds OS."
 778   (let* ((services (operating-system-services os #:container? container?))
 779          (system   (fold-services services)))
 780     ;; SYSTEM contains the derivation as a monadic value.
 781     (service-value system)))
 782
 783 (define* (operating-system-profile os #:key container?)
 784   "Return a derivation that builds the system profile of OS."
 785   (mlet* %store-monad
 786       ((services -> (operating-system-services os #:container? container?))
 787        (profile (fold-services services
 788                                #:target-type profile-service-type)))
 789     (match profile
 790       (("profile" profile)
 791        (return profile)))))
 792
 793 (define (operating-system-root-file-system os)
 794   "Return the root file system of OS."
 795   (find (match-lambda
 796          (($ <file-system> device title "/") #t)
 797          (x #f))
 798         (operating-system-file-systems os)))
 799
 800 (define (operating-system-initrd-file os)
 801   "Return a gexp denoting the initrd file of OS."
 802   (define boot-file-systems
 803     (filter file-system-needed-for-boot?
 804             (operating-system-file-systems os)))
 805
 806   (define mapped-devices
 807     (operating-system-boot-mapped-devices os))
 808
 809   (define make-initrd
 810     (operating-system-initrd os))
 811
 812   (mlet %store-monad ((initrd (make-initrd boot-file-systems
 813                                            #:linux (operating-system-kernel os)
 814                                            #:mapped-devices mapped-devices)))
 815     (return (file-append initrd "/initrd"))))
 816
 817 (define (locale-name->definition* name)
 818   "Variant of 'locale-name->definition' that raises an error upon failure."
 819   (match (locale-name->definition name)
 820     (#f
 821      (raise (condition
 822              (&message
 823               (message (format #f (G_ "~a: invalid locale name") name))))))
 824     (def def)))
 825
 826 (define (operating-system-locale-directory os)
 827   "Return the directory containing the locales compiled for the definitions
 828 listed in OS.  The C library expects to find it under
 829 /run/current-system/locale."
 830   (define name
 831     (operating-system-locale os))
 832
 833   (define definitions
 834     ;; While we're at it, check whether NAME is defined and add it if needed.
 835     (if (member name (map locale-definition-name
 836                           (operating-system-locale-definitions os)))
 837         (operating-system-locale-definitions os)
 838         (cons (locale-name->definition* name)
 839               (operating-system-locale-definitions os))))
 840
 841   (locale-directory definitions
 842                     #:libcs (operating-system-locale-libcs os)))
 843
 844 (define (kernel->boot-label kernel)
 845   "Return a label for the bootloader menu entry that boots KERNEL."
 846   (string-append "GNU with "
 847                  (string-titlecase (package-name kernel)) " "
 848                  (package-version kernel)
 849                  " (beta)"))
 850
 851 (define (store-file-system file-systems)
 852   "Return the file system object among FILE-SYSTEMS that contains the store."
 853   (match (filter (lambda (fs)
 854                    (and (file-system-mount? fs)
 855                         (not (memq 'bind-mount (file-system-flags fs)))
 856                         (string-prefix? (file-system-mount-point fs)
 857                                         (%store-prefix))))
 858                  file-systems)
 859     ((and candidates (head . tail))
 860      (reduce (lambda (fs1 fs2)
 861                (if (> (string-length (file-system-mount-point fs1))
 862                       (string-length (file-system-mount-point fs2)))
 863                    fs1
 864                    fs2))
 865              head
 866              candidates))))
 867
 868 (define (operating-system-store-file-system os)
 869   "Return the file system that contains the store of OS."
 870   (store-file-system (operating-system-file-systems os)))
 871
 872 (define* (operating-system-bootcfg os #:optional (old-entries '()))
 873   "Return the bootloader configuration file for OS.  Use OLD-ENTRIES
 874 (which is a list of <menu-entry>) to populate the \"old entries\" menu."
 875   (mlet* %store-monad
 876       ((system      (operating-system-derivation os))
 877        (root-fs ->  (operating-system-root-file-system os))
 878        (root-device -> (if (eq? 'uuid (file-system-title root-fs))
 879                            (uuid->string (file-system-device root-fs))
 880                            (file-system-device root-fs)))
 881        (params (operating-system-boot-parameters os system root-device))
 882        (entry -> (boot-parameters->menu-entry params))
 883        (bootloader-conf -> (operating-system-bootloader os)))
 884     ((bootloader-configuration-file-generator
 885       (bootloader-configuration-bootloader bootloader-conf))
 886      bootloader-conf (list entry) #:old-entries old-entries)))
 887
 888 (define (fs->boot-device fs)
 889   "Given FS, a <file-system> object, return a value suitable for use as the
 890 device in a <menu-entry>."
 891   (case (file-system-title fs)
 892     ((uuid) (file-system-device fs))
 893     ((label) (file-system-device fs))
 894     (else #f)))
 895
 896 (define (operating-system-boot-parameters os system.drv root-device)
 897   "Return a monadic <boot-parameters> record that describes the boot parameters
 898 of OS.  SYSTEM.DRV is either a derivation or #f.  If it's a derivation, adds
 899 kernel arguments for that derivation to <boot-parameters>."
 900   (mlet* %store-monad
 901       ((initrd (operating-system-initrd-file os))
 902        (store -> (operating-system-store-file-system os))
 903        (bootloader  -> (bootloader-configuration-bootloader
 904                         (operating-system-bootloader os)))
 905        (bootloader-name -> (bootloader-name bootloader))
 906        (label -> (kernel->boot-label (operating-system-kernel os))))
 907     (return (boot-parameters
 908              (label label)
 909              (root-device root-device)
 910              (kernel (operating-system-kernel-file os))
 911              (kernel-arguments
 912               (if system.drv
 913                 (operating-system-kernel-arguments os system.drv root-device)
 914                 (operating-system-user-kernel-arguments os)))
 915              (initrd initrd)
 916              (bootloader-name bootloader-name)
 917              (store-device (fs->boot-device store))
 918              (store-mount-point (file-system-mount-point store))))))
 919
 920 (define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
 921    "Return a file that describes the boot parameters of OS.  The primary use of
 922 this file is the reconstruction of GRUB menu entries for old configurations.
 923 SYSTEM.DRV is optional.  If given, adds kernel arguments for that system to the
 924 returned file (since the returned file is then usually stored into the
 925 content-addressed \"system\" directory, it's usually not a good idea
 926 to give it because the content hash would change by the content hash
 927 being stored into the \"parameters\" file)."
 928   (mlet* %store-monad ((root -> (operating-system-root-file-system os))
 929                        (device -> (file-system-device root))
 930                        (params (operating-system-boot-parameters os
 931                                                                  system.drv
 932                                                                  device)))
 933      (gexp->file "parameters"
 934                  #~(boot-parameters
 935                     (version 0)
 936                     (label #$(boot-parameters-label params))
 937                     (root-device #$(boot-parameters-root-device params))
 938                     (kernel #$(boot-parameters-kernel params))
 939                     (kernel-arguments
 940                      #$(boot-parameters-kernel-arguments params))
 941                     (initrd #$(boot-parameters-initrd params))
 942                     (bootloader-name #$(boot-parameters-bootloader-name params))
 943                     (store
 944                      (device #$(boot-parameters-store-device params))
 945                      (mount-point #$(boot-parameters-store-mount-point params))))
 946                  #:set-load-path? #f)))
 947
 948 ;;; system.scm ends here