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