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