gnu: slepc: Set origin file-name.

[jackhill/guix/guix.git] / gnu / system.scm

diff --git a/gnu/system.scm b/gnu/system.scm
index 9748113..5be24ba 100644 (file)
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1,5 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; GNU Guix --- Functional package management for GNU

-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>

 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;


@@ -24,6 +26,7 @@
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix profiles)
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix profiles)

+  #:use-module (guix ui)

   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages guile)


@@ -37,17 +40,18 @@
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages man)
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages gawk)
   #:use-module (gnu packages man)

+  #:use-module (gnu packages texinfo)

   #:use-module (gnu packages compression)
   #:use-module (gnu packages firmware)
   #:autoload   (gnu packages cryptsetup) (cryptsetup)
   #:use-module (gnu services)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages firmware)
   #:autoload   (gnu packages cryptsetup) (cryptsetup)
   #:use-module (gnu services)

-  #:use-module (gnu services dmd)
+  #:use-module (gnu services shepherd)

   #:use-module (gnu services base)
   #:use-module (gnu system grub)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)
   #:use-module (gnu services base)
   #:use-module (gnu system grub)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)

-  #:use-module (gnu system linux)
+  #:use-module (gnu system pam)

   #:use-module (gnu system linux-initrd)
   #:use-module (gnu system file-systems)
   #:use-module (ice-9 match)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu system file-systems)
   #:use-module (ice-9 match)


@@ -65,6 +69,7 @@
             operating-system-host-name
             operating-system-hosts-file
             operating-system-kernel
             operating-system-host-name
             operating-system-hosts-file
             operating-system-kernel

+            operating-system-kernel-arguments

             operating-system-initrd
             operating-system-users
             operating-system-groups
             operating-system-initrd
             operating-system-users
             operating-system-groups


@@ -72,13 +77,26 @@
             operating-system-timezone
             operating-system-locale
             operating-system-locale-definitions
             operating-system-timezone
             operating-system-locale
             operating-system-locale-definitions

+            operating-system-locale-libcs

             operating-system-mapped-devices
             operating-system-file-systems
             operating-system-mapped-devices
             operating-system-file-systems

+            operating-system-store-file-system

             operating-system-activation-script
 
             operating-system-derivation
             operating-system-profile
             operating-system-grub.cfg
             operating-system-activation-script
 
             operating-system-derivation
             operating-system-profile
             operating-system-grub.cfg

+            operating-system-etc-directory
+            operating-system-locale-directory
+            operating-system-boot-script
+
+            boot-parameters
+            boot-parameters?
+            boot-parameters-label
+            boot-parameters-root-device
+            boot-parameters-kernel
+            boot-parameters-kernel-arguments
+            read-boot-parameters

 
             local-host-aliases
             %setuid-programs
 
             local-host-aliases
             %setuid-programs


@@ -100,6 +118,8 @@
   operating-system?
   (kernel operating-system-kernel                 ; package
           (default linux-libre))
   operating-system?
   (kernel operating-system-kernel                 ; package
           (default linux-libre))

+  (kernel-arguments operating-system-kernel-arguments
+                    (default '()))                ; list of gexps/strings

   (bootloader operating-system-bootloader)        ; <grub-configuration>
 
   (initrd operating-system-initrd                 ; (list fs) -> M derivation
   (bootloader operating-system-bootloader)        ; <grub-configuration>
 
   (initrd operating-system-initrd                 ; (list fs) -> M derivation


@@ -108,7 +128,7 @@
             (default %base-firmware))
 
   (host-name operating-system-host-name)          ; string
             (default %base-firmware))
 
   (host-name operating-system-host-name)          ; string

-  (hosts-file operating-system-hosts-file         ; M item | #f
+  (hosts-file operating-system-hosts-file         ; file-like | #f

               (default #f))
 
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
               (default #f))
 
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>


@@ -118,7 +138,7 @@
                 (default '()))
 
   (users operating-system-users                   ; list of user accounts
                 (default '()))
 
   (users operating-system-users                   ; list of user accounts

-         (default '()))
+         (default %base-user-accounts))

   (groups operating-system-groups                 ; list of user groups
           (default %base-groups))
 
   (groups operating-system-groups                 ; list of user groups
           (default %base-groups))
 


@@ -135,6 +155,8 @@
             (default "en_US.utf8"))
   (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
                       (default %default-locale-definitions))
             (default "en_US.utf8"))
   (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
                       (default %default-locale-definitions))

+  (locale-libcs operating-system-locale-libcs     ; list of <packages>
+                (default %default-locale-libcs))

   (name-service-switch operating-system-name-service-switch ; <name-service-switch>
                        (default %default-nss))
 
   (name-service-switch operating-system-name-service-switch ; <name-service-switch>
                        (default %default-nss))
 


@@ -146,43 +168,8 @@
   (setuid-programs operating-system-setuid-programs
                    (default %setuid-programs))    ; list of string-valued gexps
 
   (setuid-programs operating-system-setuid-programs
                    (default %setuid-programs))    ; list of string-valued gexps
 

-  (sudoers operating-system-sudoers               ; /etc/sudoers contents
-           (default %sudoers-specification)))
-
-\f
-;;;
-;;; Derivation.
-;;;
-
-(define* (file-union name files)
-  "Return a derivation that builds a directory containing all of FILES.  Each
-item in FILES must be a list where the first element is the file name to use
-in the new directory, and the second element is a gexp denoting the target
-file."
-  (define builder
-    #~(begin
-        (mkdir #$output)
-        (chdir #$output)
-        #$@(map (match-lambda
-                 ((target source)
-                  #~(symlink #$source #$target)))
-                files)))
-
-  (gexp->derivation name builder))
-
-(define (directory-union name things)
-  "Return a directory that is the union of THINGS."
-  (match things
-    ((one)
-     ;; Only one thing; return it.
-     (with-monad %store-monad (return one)))
-    (_
-     (gexp->derivation name
-                       #~(begin
-                           (use-modules (guix build union))
-                           (union-build #$output '#$things))
-                       #:modules '((guix build union))
-                       #:local-build? #t))))
+  (sudoers-file operating-system-sudoers-file     ; file-like
+                (default %sudoers-specification)))

 
 \f
 ;;;
 
 \f
 ;;;


@@ -215,37 +202,32 @@ as 'needed-for-boot'."
             (operating-system-file-systems os)))
 
   (define (device-mappings fs)
             (operating-system-file-systems os)))
 
   (define (device-mappings fs)

-    (filter (lambda (md)
-              (string=? (string-append "/dev/mapper/"
-                                       (mapped-device-target md))
-                        (file-system-device fs)))
-            (operating-system-mapped-devices os)))
-
-  (define (requirements fs)
-    (map (lambda (md)
-           (symbol-append 'device-mapping-
-                          (string->symbol (mapped-device-target md))))
-         (device-mappings fs)))
-
-  (sequence %store-monad
-            (map (lambda (fs)
-                   (match fs
-                     (($ <file-system> device title target type flags opts
-                                       #f check? create?)
-                      (file-system-service device target type
-                                           #:title title
-                                           #:requirements (requirements fs)
-                                           #:check? check?
-                                           #:create-mount-point? create?
-                                           #:options opts
-                                           #:flags flags))))
-                 file-systems)))
+    (let ((device (file-system-device fs)))
+      (if (string? device)                        ;title is 'device
+          (filter (lambda (md)
+                    (string=? (string-append "/dev/mapper/"
+                                             (mapped-device-target md))
+                              device))
+                  (operating-system-mapped-devices os))
+          '())))
+
+  (define (add-dependencies fs)
+    ;; Add the dependencies due to device mappings to FS.
+    (file-system
+      (inherit fs)
+      (dependencies
+       (delete-duplicates (append (device-mappings fs)
+                                  (file-system-dependencies fs))
+                          eq?))))
+
+  (map (compose file-system-service add-dependencies) file-systems))

 
 (define (mapped-device-user device file-systems)
   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
     (find (lambda (fs)
 
 (define (mapped-device-user device file-systems)
   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
     (find (lambda (fs)

-            (string=? (file-system-device fs) target))
+            (and (eq? 'device (file-system-title fs))
+                 (string=? (file-system-device fs) target)))

           file-systems)))
 
 (define (operating-system-user-mapped-devices os)
           file-systems)))
 
 (define (operating-system-user-mapped-devices os)


@@ -270,51 +252,94 @@ from the initrd."
            devices)))
 
 (define (device-mapping-services os)
            devices)))
 
 (define (device-mapping-services os)

-  "Return the list of device-mapping services for OS as a monadic list."
-  (sequence %store-monad
-            (map (lambda (md)
-                   (let* ((source (mapped-device-source md))
-                          (target (mapped-device-target md))
-                          (type   (mapped-device-type md))
-                          (open   (mapped-device-kind-open type))
-                          (close  (mapped-device-kind-close type)))
-                     (device-mapping-service target
-                                             (open source target)
-                                             (close source target))))
-                 (operating-system-user-mapped-devices os))))
+  "Return the list of device-mapping services for OS as a list."
+  (map (lambda (md)
+         (let* ((source (mapped-device-source md))
+                (target (mapped-device-target md))
+                (type   (mapped-device-type md))
+                (open   (mapped-device-kind-open type))
+                (close  (mapped-device-kind-close type)))
+           (device-mapping-service target
+                                   (open source target)
+                                   (close source target))))
+       (operating-system-user-mapped-devices os)))

 
 (define (swap-services os)
 
 (define (swap-services os)

-  "Return the list of swap services for OS as a monadic list."
-  (sequence %store-monad
-            (map swap-service (operating-system-swap-devices os))))
-
-(define (essential-services os)
+  "Return the list of swap services for OS."
+  (map swap-service (operating-system-swap-devices os)))
+
+(define* (operating-system-directory-base-entries os #:key container?)
+  "Return the basic entries of the 'system' directory of OS for use as the
+value of the SYSTEM-SERVICE-TYPE service."
+  (mlet %store-monad ((locale (operating-system-locale-directory os)))
+    (if container?
+        (return `(("locale" ,locale)))
+        (mlet %store-monad
+            ((kernel  ->  (operating-system-kernel os))
+             (initrd      (operating-system-initrd-file os))
+             (params      (operating-system-parameters-file os)))
+          (return `(("kernel" ,kernel)
+                    ("parameters" ,params)
+                    ("initrd" ,initrd)
+                    ("locale" ,locale)))))))      ;used by libc
+
+(define* (essential-services os #:key container?)

   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level

-bookkeeping."
+bookkeeping.  CONTAINER? determines whether to return the list of services for
+a container or that of a \"bare metal\" system."

   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 
   (define known-fs
     (map file-system-mount-point (operating-system-file-systems os)))
 

-  (mlet* %store-monad ((mappings  (device-mapping-services os))
-                       (root-fs   (root-file-system-service))
-                       (other-fs  (other-file-system-services os))
-                       (unmount   (user-unmount-service known-fs))
-                       (swaps     (swap-services os))
-                       (procs     (user-processes-service
-                                   (map (compose first service-provision)
-                                        other-fs)))
-                       (host-name (host-name-service
-                                   (operating-system-host-name os))))
-    (return (cons* host-name procs root-fs unmount
-                   (append other-fs mappings swaps)))))
-
-(define (operating-system-services os)
+  (let* ((mappings  (device-mapping-services os))
+         (root-fs   (root-file-system-service))
+         (other-fs  (other-file-system-services os))
+         (unmount   (user-unmount-service known-fs))
+         (swaps     (swap-services os))
+         (procs     (user-processes-service
+                     (map service-parameters other-fs)))
+         (host-name (host-name-service (operating-system-host-name os)))
+         (entries   (operating-system-directory-base-entries
+                     os #:container? container?)))
+    (cons* (service system-service-type entries)
+           %boot-service
+
+           ;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
+           ;; execs shepherd comes last in the boot script (XXX).  Likewise,
+           ;; the cleanup service must come last so that its gexp runs before
+           ;; activation code.
+           %shepherd-root-service
+           %activation-service
+           (service cleanup-service-type #f)
+
+           (pam-root-service (operating-system-pam-services os))
+           (account-service (append (operating-system-accounts os)
+                                    (operating-system-groups os))
+                            (operating-system-skeletons os))
+           (operating-system-etc-service os)
+           (service fstab-service-type '())
+           (session-environment-service
+            (operating-system-environment-variables os))
+           host-name procs root-fs unmount
+           (service setuid-program-service-type
+                    (operating-system-setuid-programs os))
+           (service profile-service-type
+                    (operating-system-packages os))
+           (append other-fs mappings swaps
+
+                   ;; Add the firmware service, unless we are building for a
+                   ;; container.
+                   (if container?
+                       '()
+                       (list %linux-bare-metal-service
+                             (service firmware-service-type
+                                      (operating-system-firmware os))))))))
+
+(define* (operating-system-services os #:key container?)

   "Return all the services of OS, including \"internal\" services that do not
 explicitly appear in OS."
   "Return all the services of OS, including \"internal\" services that do not
 explicitly appear in OS."

-  (mlet %store-monad
-      ((user      (sequence %store-monad (operating-system-user-services os)))
-       (essential (essential-services os)))
-    (return (append essential user))))
+  (append (operating-system-user-services os)
+          (essential-services os #:container? container?)))

 
 \f
 ;;;
 
 \f
 ;;;


@@ -329,17 +354,18 @@ explicitly appear in OS."
   ;; Default set of packages globally visible.  It should include anything
   ;; required for basic administrator tasks.
   (cons* procps psmisc which less zile nano
   ;; Default set of packages globally visible.  It should include anything
   ;; required for basic administrator tasks.
   (cons* procps psmisc which less zile nano

-         (@ (gnu packages admin) dmd) guix

          lsof                                 ;for Guix's 'list-runtime-roots'
          pciutils usbutils
          util-linux inetutils isc-dhcp
 
          ;; wireless-tools is deprecated in favor of iw, but it's still what
          ;; many people are familiar with, so keep it around.
          lsof                                 ;for Guix's 'list-runtime-roots'
          pciutils usbutils
          util-linux inetutils isc-dhcp
 
          ;; wireless-tools is deprecated in favor of iw, but it's still what
          ;; many people are familiar with, so keep it around.

-         iw wireless-tools
+         iw wireless-tools rfkill

 
 

+         iproute

          net-tools                        ; XXX: remove when Inetutils suffices
          man-db
          net-tools                        ; XXX: remove when Inetutils suffices
          man-db

+         texinfo                               ;for the standalone Info reader

 
          ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
          ;; want the other commands and the man pages (notably because
 
          ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
          ;; want the other commands and the man pages (notably because


@@ -348,10 +374,12 @@ explicitly appear in OS."
 
          ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
          ;; already depends on it anyway.
 
          ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
          ;; already depends on it anyway.

-         kmod eudev
+         kmod eudev-with-blkid

 
          e2fsprogs kbd
 
 
          e2fsprogs kbd
 

+         bash-completion
+

          ;; The packages below are also in %FINAL-INPUTS, so take them from
          ;; there to avoid duplication.
          (map canonical-package
          ;; The packages below are also in %FINAL-INPUTS, so take them from
          ;; there to avoid duplication.
          (map canonical-package


@@ -370,116 +398,126 @@ This is the GNU system.  Welcome.\n")
 
 (define (default-/etc/hosts host-name)
   "Return the default /etc/hosts file."
 
 (define (default-/etc/hosts host-name)
   "Return the default /etc/hosts file."

-  (text-file "hosts" (local-host-aliases host-name)))
+  (plain-file "hosts" (local-host-aliases host-name)))

 
 (define (emacs-site-file)
   "Return the Emacs 'site-start.el' file.  That file contains the necessary
 settings for 'guix.el' to work out-of-the-box."
 
 (define (emacs-site-file)
   "Return the Emacs 'site-start.el' file.  That file contains the necessary
 settings for 'guix.el' to work out-of-the-box."

-  (gexp->file "site-start.el"
-              #~(progn
-                 ;; Add the "normal" elisp directory to the search path;
-                 ;; guix.el may be there.
-                 (add-to-list
-                  'load-path
-                  "/run/current-system/profile/share/emacs/site-lisp")
-
-                 ;; Attempt to load guix.el.
-                 (require 'guix-init nil t)
-
-                 (when (require 'geiser-guile nil t)
-                   ;; Make sure Geiser's Scheme modules are in Guile's search
-                   ;; path.
-                   (add-to-list
-                    'geiser-guile-load-path
-                    "/run/current-system/profile/share/geiser/guile")))))
+  (scheme-file "site-start.el"
+               #~(progn
+                  ;; Add the "normal" elisp directory to the search path;
+                  ;; guix.el may be there.
+                  (add-to-list
+                   'load-path
+                   "/run/current-system/profile/share/emacs/site-lisp")
+
+                  ;; Attempt to load guix.el.
+                  (require 'guix-init nil t)
+
+                  ;; Attempt to load geiser.
+                  (require 'geiser-install nil t))))

 
 (define (emacs-site-directory)
   "Return the Emacs site directory, aka. /etc/emacs."
 
 (define (emacs-site-directory)
   "Return the Emacs site directory, aka. /etc/emacs."

-  (mlet %store-monad ((file (emacs-site-file)))
-    (gexp->derivation "emacs"
-                      #~(begin
-                          (mkdir #$output)
-                          (chdir #$output)
-                          (symlink #$file "site-start.el")))))
-
-(define* (etc-directory #:key
-                        (locale "C") (timezone "Europe/Paris")
-                        (issue "Hello!\n")
-                        (skeletons '())
-                        (pam-services '())
-                        (profile "/run/current-system/profile")
-                        hosts-file nss
-                        (sudoers ""))
-  "Return a derivation that builds the static part of the /etc directory."
-  (mlet* %store-monad
-      ((pam.d      (pam-services->directory pam-services))
-       (sudoers    (text-file "sudoers" sudoers))
-       (login.defs (text-file "login.defs" "# Empty for now.\n"))
-       (shells     (text-file "shells"            ; used by xterm and others
-                              "\
-/bin/sh
-/run/current-system/profile/bin/sh
-/run/current-system/profile/bin/bash\n"))
-       (emacs      (emacs-site-directory))
-       (issue      (text-file "issue" issue))
-       (nsswitch   (text-file "nsswitch.conf"
-                              (name-service-switch->string nss)))
-
-       ;; Startup file for POSIX-compliant login shells, which set system-wide
-       ;; environment variables.
-       (profile    (text-file* "profile"  "\
-export LANG=\"" locale "\"
-export TZ=\"" timezone "\"
-export TZDIR=\"" tzdata "/share/zoneinfo\"
-
-# Tell 'modprobe' & co. where to look for modules.
-export LINUX_MODULE_DIRECTORY=/run/booted-system/kernel/lib/modules
-
-export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin
-export PATH=/run/setuid-programs:/run/current-system/profile/sbin:$PATH
+  (computed-file "emacs"
+                 #~(begin
+                     (mkdir #$output)
+                     (chdir #$output)
+                     (symlink #$(emacs-site-file) "site-start.el"))))
+
+(define* (operating-system-etc-service os)
+  "Return a <service> that builds containing the static part of the /etc
+directory."
+  (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
+
+        (emacs      (emacs-site-directory))
+        (issue      (plain-file "issue" (operating-system-issue os)))
+        (nsswitch   (plain-file "nsswitch.conf"
+                                (name-service-switch->string
+                                 (operating-system-name-service-switch os))))
+
+        ;; Startup file for POSIX-compliant login shells, which set system-wide
+        ;; environment variables.
+        (profile    (mixed-text-file "profile"  "\
+# Crucial variables that could be missing in the profiles' 'etc/profile'
+# because they would require combining both profiles.
+# FIXME: See <http://bugs.gnu.org/20255>.

 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
 export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
 export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info

-

 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
 
 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
 

-# Append the directory of 'site-start.el' to the search path.
-export EMACSLOADPATH=:/etc/emacs
-
-# By default, applications that use D-Bus, such as Emacs, abort at startup
-# when /etc/machine-id is missing.  Make sure these warnings are non-fatal.
-export DBUS_FATAL_WARNINGS=0
-
-# These variables are honored by OpenSSL (libssl) and Git.
-export SSL_CERT_DIR=/etc/ssl/certs
-export SSL_CERT_FILE=\"$SSL_CERT_DIR/ca-certificates.crt\"
-export GIT_SSL_CAINFO=\"$SSL_CERT_FILE\"
-
-# Allow Aspell to find dictionaries installed in the user profile.
-export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\"
+# Ignore the default value of 'PATH'.
+unset PATH
+
+# Load the system profile's settings.
+GUIX_PROFILE=/run/current-system/profile \\
+. /run/current-system/profile/etc/profile
+
+# Prepend setuid programs.
+export PATH=/run/setuid-programs:$PATH
+
+if [ -f \"$HOME/.guix-profile/etc/profile\" ]
+then
+  # Load the user profile's settings.
+  GUIX_PROFILE=\"$HOME/.guix-profile\" \\
+  . \"$HOME/.guix-profile/etc/profile\"
+else
+  # At least define this one so that basic things just work
+  # when the user installs their first package.
+  export PATH=\"$HOME/.guix-profile/bin:$PATH\"
+fi
+
+# Since 'lshd' does not use pam_env, /etc/environment must be explicitly
+# loaded when someone logs in via SSH.  See <http://bugs.gnu.org/22175>.
+# We need 'PATH' to be defined here, for 'cat' and 'cut'.
+if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
+     -a -z \"$LINUX_MODULE_DIRECTORY\" ]
+then
+  . /etc/environment
+  export `cat /etc/environment | cut -d= -f1`
+fi
+
+# Set the umask, notably for users logging in via 'lsh'.
+# See <http://bugs.gnu.org/22650>.
+umask 022
+
+# Allow GStreamer-based applications to find plugins.
+export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
+
+if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
+then
+  # Load Bash-specific initialization code.
+  . /etc/bashrc
+fi

 "))
 "))

-       (skel      (skeleton-directory skeletons)))
-    (file-union "etc"
-                `(("services" ,#~(string-append #$net-base "/etc/services"))
-                  ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
-                  ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
-                  ("emacs" ,#~#$emacs)
-                  ("pam.d" ,#~#$pam.d)
-                  ("login.defs" ,#~#$login.defs)
-                  ("issue" ,#~#$issue)
-                  ("nsswitch.conf" ,#~#$nsswitch)
-                  ("skel" ,#~#$skel)
-                  ("shells" ,#~#$shells)
-                  ("profile" ,#~#$profile)
-                  ("hosts" ,#~#$hosts-file)
-                  ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
-                                                 #$timezone))
-                  ("sudoers" ,#~#$sudoers)))))
-
-(define (operating-system-profile os)
-  "Return a derivation that builds the system profile of OS."
-  (profile-derivation (manifest (map package->manifest-entry
-                                     (operating-system-packages os)))))
+
+        (bashrc    (plain-file "bashrc" "\
+# Bash-specific initialization.
+
+# The 'bash-completion' package.
+if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
+then
+  # Bash-completion sources ~/.bash_completion.  It installs a dynamic
+  # completion loader that searches its own completion files as well
+  # as those in ~/.guix-profile and /run/current-system/profile.
+  source /run/current-system/profile/etc/profile.d/bash_completion.sh
+fi\n")))
+    (etc-service
+     `(("services" ,#~(string-append #$net-base "/etc/services"))
+       ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
+       ("rpc" ,#~(string-append #$net-base "/etc/rpc"))
+       ("emacs" ,#~#$emacs)
+       ("login.defs" ,#~#$login.defs)
+       ("issue" ,#~#$issue)
+       ("nsswitch.conf" ,#~#$nsswitch)
+       ("profile" ,#~#$profile)
+       ("bashrc" ,#~#$bashrc)
+       ("hosts" ,#~#$(or (operating-system-hosts-file os)
+                         (default-/etc/hosts (operating-system-host-name os))))
+       ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
+                                      #$(operating-system-timezone os)))
+       ("sudoers" ,(operating-system-sudoers-file os))))))

 
 (define %root-account
   ;; Default root account.
 
 (define %root-account
   ;; Default root account.


@@ -491,40 +529,71 @@ export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\"
    (home-directory "/root")))
 
 (define (operating-system-accounts os)
    (home-directory "/root")))
 
 (define (operating-system-accounts os)

-  "Return the user accounts for OS, including an obligatory 'root' account."
-  (define users
-    ;; Make sure there's a root account.
-    (if (find (lambda (user)
-                (and=> (user-account-uid user) zero?))
-              (operating-system-users os))
-        (operating-system-users os)
-        (cons %root-account (operating-system-users os))))
-
-  (mlet %store-monad ((services (operating-system-services os)))
-    (return (append users
-                    (append-map service-user-accounts services)))))
+  "Return the user accounts for OS, including an obligatory 'root' account,
+and excluding accounts requested by services."
+  ;; Make sure there's a root account.
+  (if (find (lambda (user)
+              (and=> (user-account-uid user) zero?))
+            (operating-system-users os))
+      (operating-system-users os)
+      (cons %root-account (operating-system-users os))))
+
+(define (maybe-string->file file-name thing)
+  "If THING is a string, return a <plain-file> with THING as its content.
+Otherwise just return THING.
+
+This is for backward-compatibility of fields that used to be strings and are
+now file-like objects.."
+  (match thing
+    ((? string?)
+     (warning (_ "using a string for file '~a' is deprecated; \
+use 'plain-file' instead~%")
+              file-name)
+     (plain-file file-name thing))
+    (x
+     x)))
+
+(define (maybe-file->monadic file-name thing)
+  "If THING is a value in %STORE-MONAD, return it as is; otherwise return
+THING in the %STORE-MONAD.
+
+This is for backward-compatibility of fields that used to be monadic values
+and are now file-like objects."
+  (with-monad %store-monad
+    (match thing
+      ((? procedure?)
+       (warning (_ "using a monadic value for '~a' is deprecated; \
+use 'plain-file' instead~%")
+                file-name)
+       thing)
+      (x
+       (return x)))))

 
 (define (operating-system-etc-directory os)
   "Return that static part of the /etc directory of OS."
 
 (define (operating-system-etc-directory os)
   "Return that static part of the /etc directory of OS."

-  (mlet* %store-monad
-      ((services     (operating-system-services os))
-       (pam-services ->
-                     ;; Services known to PAM.
-                     (append (operating-system-pam-services os)
-                             (append-map service-pam-services services)))
-       (profile-drv (operating-system-profile os))
-       (skeletons   (operating-system-skeletons os))
-       (/etc/hosts  (or (operating-system-hosts-file os)
-                        (default-/etc/hosts (operating-system-host-name os)))))
-   (etc-directory #:pam-services pam-services
-                  #:skeletons skeletons
-                  #:issue (operating-system-issue os)
-                  #:locale (operating-system-locale os)
-                  #:nss (operating-system-name-service-switch os)
-                  #:timezone (operating-system-timezone os)
-                  #:hosts-file /etc/hosts
-                  #:sudoers (operating-system-sudoers os)
-                  #:profile profile-drv)))
+  (etc-directory
+   (fold-services (operating-system-services os)
+                  #:target-type etc-service-type)))
+
+(define (operating-system-environment-variables os)
+  "Return the environment variables of OS for
+@var{session-environment-service-type}, to be used in @file{/etc/environment}."
+  `(("LANG" . ,(operating-system-locale os))
+    ("TZ" . ,(operating-system-timezone os))
+    ("TZDIR" . ,#~(string-append #$tzdata "/share/zoneinfo"))
+    ;; Tell 'modprobe' & co. where to look for modules.
+    ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
+    ;; These variables are honored by OpenSSL (libssl) and Git.
+    ("SSL_CERT_DIR" . "/etc/ssl/certs")
+    ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
+    ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
+    ;; Prepend the directory of 'site-start.el' to the search path, so
+    ;; that it has higher precedence than the 'site-start.el' file our
+    ;; Emacs package provides.
+    ("EMACSLOADPATH" . "/etc/emacs:")
+    ;; By default, applications that use D-Bus, such as Emacs, abort at startup
+    ;; when /etc/machine-id is missing.  Make sure these warnings are non-fatal.
+    ("DBUS_FATAL_WARNINGS" . "0")))

 
 (define %setuid-programs
   ;; Default set of setuid-root programs.
 
 (define %setuid-programs
   ;; Default set of setuid-root programs.


@@ -532,6 +601,7 @@ export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\"
     (list #~(string-append #$shadow "/bin/passwd")
           #~(string-append #$shadow "/bin/su")
           #~(string-append #$inetutils "/bin/ping")
     (list #~(string-append #$shadow "/bin/passwd")
           #~(string-append #$shadow "/bin/su")
           #~(string-append #$inetutils "/bin/ping")

+          #~(string-append #$inetutils "/bin/ping6")

           #~(string-append #$sudo "/bin/sudo")
           #~(string-append #$fuse "/bin/fusermount"))))
 
           #~(string-append #$sudo "/bin/sudo")
           #~(string-append #$fuse "/bin/fusermount"))))
 


@@ -540,155 +610,44 @@ export ASPELL_CONF=\"dict-dir $HOME/.guix-profile/lib/aspell\"
   ;; group can do anything.  See
   ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
   ;; TODO: Add a declarative API.
   ;; group can do anything.  See
   ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
   ;; TODO: Add a declarative API.

-  "root ALL=(ALL) ALL
-%wheel ALL=(ALL) ALL\n")
-
-(define (user-group->gexp group)
-  "Turn GROUP, a <user-group> object, into a list-valued gexp suitable for
-'active-groups'."
-  #~(list #$(user-group-name group)
-          #$(user-group-password group)
-          #$(user-group-id group)
-          #$(user-group-system? group)))
-
-(define (user-account->gexp account)
-  "Turn ACCOUNT, a <user-account> object, into a list-valued gexp suitable for
-'activate-users'."
-  #~`(#$(user-account-name account)
-      #$(user-account-uid account)
-      #$(user-account-group account)
-      #$(user-account-supplementary-groups account)
-      #$(user-account-comment account)
-      #$(user-account-home-directory account)
-      ,#$(user-account-shell account)             ; this one is a gexp
-      #$(user-account-password account)
-      #$(user-account-system? account)))
-
-(define (modprobe-wrapper)
-  "Return a wrapper for the 'modprobe' command that knows where modules live.
-
-This wrapper is typically invoked by the Linux kernel ('call_modprobe', in
-kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY' environment
-variable is not set---hence the need for this wrapper."
-  (let ((modprobe "/run/current-system/profile/bin/modprobe"))
-    (gexp->script "modprobe"
-                  #~(begin
-                      (setenv "LINUX_MODULE_DIRECTORY"
-                              "/run/booted-system/kernel/lib/modules")
-                      (apply execl #$modprobe
-                             (cons #$modprobe (cdr (command-line))))))))
-
-(define (operating-system-activation-script os)
+  (plain-file "sudoers" "\
+root ALL=(ALL) ALL
+%wheel ALL=(ALL) ALL\n"))
+
+(define* (operating-system-activation-script os #:key container?)

   "Return the activation script for OS---i.e., the code that \"activates\" the
 stateful part of OS, including user accounts and groups, special directories,
 etc."
   "Return the activation script for OS---i.e., the code that \"activates\" the
 stateful part of OS, including user accounts and groups, special directories,
 etc."

-  (define %modules
-    '((gnu build activation)
-      (gnu build linux-boot)
-      (gnu build linux-modules)
-      (gnu build file-systems)
-      (guix build utils)
-      (guix elf)))
-
-  (define (service-activations services)
-    ;; Return the activation scripts for SERVICES.
-    (let ((gexps (filter-map service-activate services)))
-      (sequence %store-monad (map (cut gexp->file "activate-service.scm" <>)
-                                  gexps))))
-
-  (mlet* %store-monad ((services (operating-system-services os))
-                       (actions  (service-activations services))
-                       (etc      (operating-system-etc-directory os))
-                       (modules  (imported-modules %modules))
-                       (compiled (compiled-modules %modules))
-                       (modprobe (modprobe-wrapper))
-                       (firmware (directory-union
-                                  "firmware" (operating-system-firmware os)))
-                       (accounts (operating-system-accounts os)))
-    (define setuid-progs
-      (operating-system-setuid-programs os))
-
-    (define user-specs
-      (map user-account->gexp accounts))
-
-    (define groups
-      (append (operating-system-groups os)
-              (append-map service-user-groups services)))
-
-    (define group-specs
-      (map user-group->gexp groups))
-
-    (gexp->file "activate"
-                #~(begin
-                    (eval-when (expand load eval)
-                      ;; Make sure 'use-modules' below succeeds.
-                      (set! %load-path (cons #$modules %load-path))
-                      (set! %load-compiled-path
-                            (cons #$compiled %load-compiled-path)))
-
-                    (use-modules (gnu build activation))
-
-                    ;; Make sure /bin/sh is valid and current.
-                    (activate-/bin/sh
-                     (string-append #$(canonical-package bash)
-                                    "/bin/sh"))
-
-                    ;; Populate /etc.
-                    (activate-etc #$etc)
-
-                    ;; Add users and user groups.
-                    (setenv "PATH"
-                            (string-append #$(@ (gnu packages admin) shadow)
-                                           "/sbin"))
-                    (activate-users+groups (list #$@user-specs)
-                                           (list #$@group-specs))
-
-                    ;; Activate setuid programs.
-                    (activate-setuid-programs (list #$@setuid-progs))
-
-                    ;; Tell the kernel to use our 'modprobe' command.
-                    (activate-modprobe #$modprobe)
-
-                    ;; Tell the kernel where firmware is.
-                    (activate-firmware
-                     (string-append #$firmware "/lib/firmware"))
-
-                    ;; Run the services' activation snippets.
-                    ;; TODO: Use 'load-compiled'.
-                    (for-each primitive-load '#$actions)
-
-                    ;; Set up /run/current-system.
-                    (activate-current-system)))))
-
-(define (operating-system-boot-script os)
+  (let* ((services   (operating-system-services os #:container? container?))
+         (activation (fold-services services
+                                    #:target-type activation-service-type)))
+    (activation-service->script activation)))
+
+(define* (operating-system-boot-script os #:key container?)

   "Return the boot script for OS---i.e., the code started by the initrd once
   "Return the boot script for OS---i.e., the code started by the initrd once

-we're running in the final root."
-  (mlet* %store-monad ((services (operating-system-services os))
-                       (activate (operating-system-activation-script os))
-                       (dmd-conf (dmd-configuration-file services)))
-    (gexp->file "boot"
-                #~(begin
-                    ;; Activate the system.
-                    ;; TODO: Use 'load-compiled'.
-                    (primitive-load #$activate)
-
-                    ;; Keep track of the booted system.
-                    (false-if-exception (delete-file "/run/booted-system"))
-                    (symlink (readlink "/run/current-system")
-                             "/run/booted-system")
-
-                    ;; Close any remaining open file descriptors to be on the
-                    ;; safe side.  This must be the very last thing we do,
-                    ;; because Guile has internal FDs such as 'sleep_pipe'
-                    ;; that need to be alive.
-                    (let loop ((fd 3))
-                      (when (< fd 1024)
-                        (false-if-exception (close-fdes fd))
-                        (loop (+ 1 fd))))
-
-                    ;; Start dmd.
-                    (execl (string-append #$dmd "/bin/dmd")
-                           "dmd" "--config" #$dmd-conf)))))
+we're running in the final root.  When CONTAINER? is true, skip all
+hardware-related operations as necessary when booting a Linux container."
+  (let* ((services (operating-system-services os #:container? container?))
+         (boot     (fold-services services #:target-type boot-service-type)))
+    ;; BOOT is the script as a monadic value.
+    (service-parameters boot)))
+
+(define* (operating-system-derivation os #:key container?)
+  "Return a derivation that builds OS."
+  (let* ((services (operating-system-services os #:container? container?))
+         (system   (fold-services services)))
+    ;; SYSTEM contains the derivation as a monadic value.
+    (service-parameters system)))
+
+(define* (operating-system-profile os #:key container?)
+  "Return a derivation that builds the system profile of OS."
+  (mlet* %store-monad
+      ((services -> (operating-system-services os #:container? container?))
+       (profile (fold-services services
+                               #:target-type profile-service-type)))
+    (match profile
+      (("profile" profile)
+       (return profile)))))

 
 (define (operating-system-root-file-system os)
   "Return the root file system of OS."
 
 (define (operating-system-root-file-system os)
   "Return the root file system of OS."


@@ -710,28 +669,64 @@ we're running in the final root."
     (operating-system-initrd os))
 
   (mlet %store-monad ((initrd (make-initrd boot-file-systems
     (operating-system-initrd os))
 
   (mlet %store-monad ((initrd (make-initrd boot-file-systems

+                                           #:linux (operating-system-kernel os)

                                            #:mapped-devices mapped-devices)))
     (return #~(string-append #$initrd "/initrd"))))
 
                                            #:mapped-devices mapped-devices)))
     (return #~(string-append #$initrd "/initrd"))))
 

+(define (locale-name->definition* name)
+  "Variant of 'locale-name->definition' that raises an error upon failure."
+  (match (locale-name->definition name)
+    (#f
+     (raise (condition
+             (&message
+              (message (format #f (_ "~a: invalid locale name") name))))))
+    (def def)))
+

 (define (operating-system-locale-directory os)
   "Return the directory containing the locales compiled for the definitions
 listed in OS.  The C library expects to find it under
 /run/current-system/locale."
 (define (operating-system-locale-directory os)
   "Return the directory containing the locales compiled for the definitions
 listed in OS.  The C library expects to find it under
 /run/current-system/locale."

-  ;; While we're at it, check whether the locale of OS is defined.
-  (unless (member (operating-system-locale os)
-                  (map locale-definition-name
-                       (operating-system-locale-definitions os)))
-    (raise (condition
-            (&message (message "system locale lacks a definition")))))
+  (define name
+    (operating-system-locale os))

 
 

-  (locale-directory (operating-system-locale-definitions os)))
+  (define definitions
+    ;; While we're at it, check whether NAME is defined and add it if needed.
+    (if (member name (map locale-definition-name
+                          (operating-system-locale-definitions os)))
+        (operating-system-locale-definitions os)
+        (cons (locale-name->definition* name)
+              (operating-system-locale-definitions os))))
+
+  (locale-directory definitions
+                    #:libcs (operating-system-locale-libcs os)))

 
 (define (kernel->grub-label kernel)
   "Return a label for the GRUB menu entry that boots KERNEL."
   (string-append "GNU with "
                  (string-titlecase (package-name kernel)) " "
                  (package-version kernel)
 
 (define (kernel->grub-label kernel)
   "Return a label for the GRUB menu entry that boots KERNEL."
   (string-append "GNU with "
                  (string-titlecase (package-name kernel)) " "
                  (package-version kernel)

-                 " (alpha)"))
+                 " (beta)"))
+
+(define (store-file-system file-systems)
+  "Return the file system object among FILE-SYSTEMS that contains the store."
+  (match (filter (lambda (fs)
+                   (and (file-system-mount? fs)
+                        (not (memq 'bind-mount (file-system-flags fs)))
+                        (string-prefix? (file-system-mount-point fs)
+                                        (%store-prefix))))
+                 file-systems)
+    ((and candidates (head . tail))
+     (reduce (lambda (fs1 fs2)
+               (if (> (string-length (file-system-mount-point fs1))
+                      (string-length (file-system-mount-point fs2)))
+                   fs1
+                   fs2))
+             head
+             candidates))))
+
+(define (operating-system-store-file-system os)
+  "Return the file system that contains the store of OS."
+  (store-file-system (operating-system-file-systems os)))

 
 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
   "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the
 
 (define* (operating-system-grub.cfg os #:optional (old-entries '()))
   "Return the GRUB configuration file for OS.  Use OLD-ENTRIES to populate the


@@ -739,18 +734,23 @@ listed in OS.  The C library expects to find it under
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))
   (mlet* %store-monad
       ((system      (operating-system-derivation os))
        (root-fs ->  (operating-system-root-file-system os))

+       (store-fs -> (operating-system-store-file-system os))

        (kernel ->   (operating-system-kernel os))
        (kernel ->   (operating-system-kernel os))

+       (root-device -> (if (eq? 'uuid (file-system-title root-fs))
+                           (uuid->string (file-system-device root-fs))
+                           (file-system-device root-fs)))

        (entries ->  (list (menu-entry
                            (label (kernel->grub-label kernel))
                            (linux kernel)
                            (linux-arguments
        (entries ->  (list (menu-entry
                            (label (kernel->grub-label kernel))
                            (linux kernel)
                            (linux-arguments

-                            (list (string-append "--root="
-                                                 (file-system-device root-fs))
-                                  #~(string-append "--system=" #$system)
-                                  #~(string-append "--load=" #$system
-                                                   "/boot")))
+                            (cons* (string-append "--root=" root-device)
+                                   #~(string-append "--system=" #$system)
+                                   #~(string-append "--load=" #$system
+                                                    "/boot")
+                                   (operating-system-kernel-arguments os)))

                            (initrd #~(string-append #$system "/initrd"))))))
                            (initrd #~(string-append #$system "/initrd"))))))

-    (grub-configuration-file (operating-system-bootloader os) entries
+    (grub-configuration-file (operating-system-bootloader os)
+                             store-fs entries

                              #:old-entries old-entries)))
 
 (define (operating-system-parameters-file os)
                              #:old-entries old-entries)))
 
 (define (operating-system-parameters-file os)


@@ -765,25 +765,41 @@ this file is the reconstruction of GRUB menu entries for old configurations."
                                    (label #$label)
                                    (root-device #$(file-system-device root))
                                    (kernel #$(operating-system-kernel os))
                                    (label #$label)
                                    (root-device #$(file-system-device root))
                                    (kernel #$(operating-system-kernel os))

+                                   (kernel-arguments
+                                    #$(operating-system-kernel-arguments os))

                                    (initrd #$initrd)))))
 
                                    (initrd #$initrd)))))
 

-(define (operating-system-derivation os)
-  "Return a derivation that builds OS."
-  (mlet* %store-monad
-      ((profile     (operating-system-profile os))
-       (etc         (operating-system-etc-directory os))
-       (boot        (operating-system-boot-script os))
-       (kernel  ->  (operating-system-kernel os))
-       (initrd      (operating-system-initrd-file os))
-       (locale      (operating-system-locale-directory os))
-       (params      (operating-system-parameters-file os)))
-    (file-union "system"
-                `(("boot" ,#~#$boot)
-                  ("kernel" ,#~#$kernel)
-                  ("parameters" ,#~#$params)
-                  ("initrd" ,initrd)
-                  ("profile" ,#~#$profile)
-                  ("locale" ,#~#$locale)          ;used by libc
-                  ("etc" ,#~#$etc)))))
+\f
+;;;
+;;; Boot parameters
+;;;
+
+(define-record-type* <boot-parameters>
+  boot-parameters make-boot-parameters boot-parameters?
+  (label            boot-parameters-label)
+  (root-device      boot-parameters-root-device)
+  (kernel           boot-parameters-kernel)
+  (kernel-arguments boot-parameters-kernel-arguments))
+
+(define (read-boot-parameters port)
+  "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object or #f if the format is unrecognized."
+  (match (read port)
+    (('boot-parameters ('version 0)
+                       ('label label) ('root-device root)
+                       ('kernel linux)
+                       rest ...)
+     (boot-parameters
+      (label label)
+      (root-device root)
+      (kernel linux)
+      (kernel-arguments
+       (match (assq 'kernel-arguments rest)
+         ((_ args) args)
+         (#f       '())))))                       ;the old format
+    (x                                            ;unsupported format
+     (warning (_ "unrecognized boot parameters for '~a'~%")
+              system)
+     #f)))

 
 ;;; system.scm ends here
 
 ;;; system.scm ends here