Merge branch 'master' into core-updates

10 files changed, 153 insertions, 63 deletions

diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 988b8f937f..ee660e0589 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -3,7 +3,7 @@
 
 (use-modules (gnu) (gnu system nss))
 (use-service-modules desktop)
-(use-package-modules xfce ratpoison wicd avahi xorg certs)
+(use-package-modules xfce ratpoison certs)
 
 (operating-system
   (host-name "antelope")
@@ -32,7 +32,6 @@
   ;; Add Xfce and Ratpoison; that allows us to choose
   ;; sessions using either of these at the log-in screen.
   (packages (cons* xfce ratpoison    ;desktop environments
-                   xterm wicd avahi  ;useful tools
                    nss-certs         ;for HTTPS access
                    %base-packages))
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 8155b273e3..0a4b385fe3 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -99,9 +99,8 @@
                     (default #t))
   (create-mount-point? file-system-create-mount-point? ; Boolean
                        (default #f))
-  (dependencies     file-system-dependencies      ; list of strings (mount
-                                                  ; points depended on)
-                    (default '())))
+  (dependencies     file-system-dependencies      ; list of <file-system>
+                    (default '())))               ; or <mapped-device>
 
 (define-inlinable (file-system-needed-for-boot? fs)
   "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index e49b6dbe54..5b824820b1 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -30,6 +30,7 @@
   #:autoload   (gnu packages imagemagick) (imagemagick)
   #:autoload   (gnu packages compression) (gzip)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
   #:export (grub-image
             grub-image?
@@ -139,7 +140,7 @@
                          (system* (string-append #$imagemagick "/bin/convert")
                                   "-resize" #$size #$image #$output)))))
 
-(define* (grub-background-image config #:key (width 640) (height 480))
+(define* (grub-background-image config #:key (width 1024) (height 768))
   "Return the GRUB background image defined in CONFIG with a ratio of
 WIDTH/HEIGHT, or #f if none was found."
   (let* ((ratio (/ width height))
@@ -152,10 +153,26 @@ WIDTH/HEIGHT, or #f if none was found."
         (with-monad %store-monad
           (return #f)))))
 
-(define (eye-candy config port)
+(define (eye-candy config system port)
   "Return in %STORE-MONAD a gexp that writes to PORT (a port-valued gexp) the
 'grub.cfg' part concerned with graphics mode, background images, colors, and
 all that."
+  (define setup-gfxterm-body
+    ;; Intel systems need to be switched into graphics mode, whereas most
+    ;; other modern architectures have no other mode and therefore don't need
+    ;; to be switched.
+    (if (string-match "^(x86_64|i[3-6]86)-" system)
+        "
+  # Leave 'gfxmode' to 'auto'.
+  insmod vbe
+  insmod vga
+  insmod video_bochs
+  insmod video_cirrus
+  insmod gfxterm
+  terminal_output gfxterm
+"
+        ""))
+
   (define (theme-colors type)
     (let* ((theme  (grub-configuration-theme config))
            (colors (type theme)))
@@ -163,22 +180,15 @@ all that."
                      (symbol->string (assoc-ref colors 'bg)))))
 
   (mlet* %store-monad ((image (grub-background-image config)))
-    (return (and image #~(format #$port "
-function load_video {
-  insmod vbe
-  insmod vga
-  insmod video_bochs
-  insmod video_cirrus
-}
+    (return (and image
+                 #~(format #$port "
+function setup_gfxterm {~a}
 
 # Set 'root' to the partition that contains /gnu/store.
 search --file --set ~a/share/grub/unicode.pf2
 
 if loadfont ~a/share/grub/unicode.pf2; then
-  set gfxmode=640x480
-  load_video
-  insmod gfxterm
-  terminal_output gfxterm
+  setup_gfxterm
 fi
 
 insmod png
@@ -189,10 +199,11 @@ else
   set menu_color_normal=cyan/blue
   set menu_color_highlight=white/blue
 fi~%"
-                        #$grub #$grub
-                        #$image
-                        #$(theme-colors grub-theme-color-normal)
-                        #$(theme-colors grub-theme-color-highlight))))))
+                           #$setup-gfxterm-body
+                           #$grub #$grub
+                           #$image
+                           #$(theme-colors grub-theme-color-normal)
+                           #$(theme-colors grub-theme-color-highlight))))))
 
 
 ;;;
@@ -206,6 +217,11 @@ fi~%"
   "Return the GRUB configuration file corresponding to CONFIG, a
 <grub-configuration> object.  OLD-ENTRIES is taken to be a list of menu
 entries corresponding to old generations of the system."
+  (define linux-image-name
+    (if (string-prefix? "mips" system)
+        "vmlinuz"
+        "bzImage"))
+
   (define all-entries
     (append entries (grub-configuration-menu-entries config)))
 
@@ -214,16 +230,17 @@ entries corresponding to old generations of the system."
      (($ <menu-entry> label linux arguments initrd)
       #~(format port "menuentry ~s {
   # Set 'root' to the partition that contains the kernel.
-  search --file --set ~a/bzImage~%
+  search --file --set ~a/~a~%
 
-  linux ~a/bzImage ~a
+  linux ~a/~a ~a
   initrd ~a
 }~%"
                 #$label
-                #$linux #$linux (string-join (list #$@arguments))
+                #$linux #$linux-image-name
+                #$linux #$linux-image-name (string-join (list #$@arguments))
                 #$initrd))))
 
-  (mlet %store-monad ((sugar (eye-candy config #~port)))
+  (mlet %store-monad ((sugar (eye-candy config system #~port)))
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 93a6f18c49..887bceb155 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -306,6 +306,9 @@ You have been warned.  Thanks for being so brave.
           (console-font-service "tty5")
           (console-font-service "tty6")
 
+          ;; To facilitate copy/paste.
+          (gpm-service)
+
           ;; Since this is running on a USB stick with a unionfs as the root
           ;; file system, use an appropriate cache configuration.
           (nscd-service (nscd-configuration
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index fdf7460872..4f38c5cb0a 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix monads)
   #:use-module (gnu build linux-container)
+  #:use-module (gnu services)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:export (mapping->file-system
@@ -46,19 +47,6 @@
        (check? #f)
        (create-mount-point? #t)))))
 
-(define (system-container os)
-  "Return a derivation that builds OS as a Linux container."
-  (mlet* %store-monad
-      ((profile (operating-system-profile os))
-       (etc     (operating-system-etc-directory os))
-       (boot    (operating-system-boot-script os #:container? #t))
-       (locale  (operating-system-locale-directory os)))
-    (file-union "system-container"
-                `(("boot" ,#~#$boot)
-                  ("profile" ,#~#$profile)
-                  ("locale" ,#~#$locale)
-                  ("etc" ,#~#$etc)))))
-
 (define (containerized-operating-system os mappings)
   "Return an operating system based on OS for use in a Linux container
 environment.  MAPPINGS is a list of <file-system-mapping> to realize in the
@@ -93,7 +81,9 @@ that will be shared with the host system."
                                (operating-system-file-systems os)))
          (specs        (map file-system->spec file-systems)))
 
-    (mlet* %store-monad ((os-drv (system-container os)))
+    (mlet* %store-monad ((os-drv (operating-system-derivation
+                                  os
+                                  #:container? #t)))
 
       (define script
         #~(begin
@@ -106,7 +96,12 @@ that will be shared with the host system."
                 (setenv "TMPDIR" "/tmp")
                 (setenv "GUIX_NEW_SYSTEM" #$os-drv)
                 (for-each mkdir-p '("/run" "/bin" "/etc" "/home" "/var"))
-                (primitive-load (string-append #$os-drv "/boot"))))))
+                (primitive-load (string-append #$os-drv "/boot")))
+              ;; A range of 65536 uid/gids is used to cover 16 bits worth of
+              ;; users and groups, which is sufficient for most cases.
+              ;;
+              ;; See: http://www.freedesktop.org/software/systemd/man/systemd-nspawn.html#--private-users=
+              #:host-uids 65536)))
 
       (gexp->script "run-container" script
                     #:modules '((ice-9 match)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 519373fe34..6130e020c8 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -178,11 +178,13 @@ loaded at boot time in the order in which they appear."
   (define linux-modules
     ;; Modules added to the initrd and loaded from the initrd.
     `("ahci"                                  ;for SATA controllers
-      "pata_acpi" "pata_atiixp"               ;for ATA controllers
-      "isci"                              ;for SAS controllers like Intel C602
       "usb-storage" "uas"                     ;for the installation image etc.
       "usbkbd" "usbhid"                       ;USB keyboards, for debugging
       "dm-crypt" "xts"                        ;for encrypted root partitions
+      ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
+            '("pata_acpi" "pata_atiixp"    ;for ATA controllers
+              "isci")                      ;for SAS controllers like Intel C602
+            '())
       ,@(if (or virtio? qemu-networking?)
             virtio-modules
             '())
diff --git a/gnu/system/locale.scm b/gnu/system/locale.scm
index 010fb45272..e798827a01 100644
--- a/gnu/system/locale.scm
+++ b/gnu/system/locale.scm
@@ -18,11 +18,15 @@
 
 (define-module (gnu system locale)
   #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix monads)
   #:use-module (guix records)
   #:use-module (guix packages)
+  #:use-module (guix utils)
   #:use-module (gnu packages base)
   #:use-module (gnu packages compression)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
   #:export (locale-definition
             locale-definition?
             locale-definition-name
@@ -31,6 +35,7 @@
 
             locale-directory
 
+            %default-locale-libcs
             %default-locale-definitions))
 
 ;;; Commentary:
@@ -50,6 +55,15 @@
 (define* (localedef-command locale
                             #:key (libc (canonical-package glibc)))
   "Return a gexp that runs 'localedef' from LIBC to build LOCALE."
+  (define (maybe-version-directory)
+    ;; XXX: For libc prior to 2.22, GuixSD did not store locale data in a
+    ;; version-specific sub-directory.  Check whether this is the case.
+    ;; TODO: Remove this hack once libc 2.21 is buried.
+    (let ((version (package-version libc)))
+      (if (version>=? version "2.22")
+          (list version "/")
+          '())))
+
   #~(begin
       (format #t "building locale '~a'...~%"
               #$(locale-definition-name locale))
@@ -58,20 +72,29 @@
                       "-i" #$(locale-definition-source locale)
                       "-f" #$(locale-definition-charset locale)
                       (string-append #$output "/"
-                                     #$(package-version libc) "/"
+                                     #$@(maybe-version-directory)
                                      #$(locale-definition-name locale))))))
 
-(define* (locale-directory locales
-                           #:key (libc (canonical-package glibc)))
+(define* (single-locale-directory locales
+                                  #:key (libc (canonical-package glibc)))
   "Return a directory containing all of LOCALES for LIBC compiled.
 
 Because locale data formats are incompatible when switching from one libc to
 another, locale data is put in a sub-directory named after the 'version' field
 of LIBC."
+  (define version
+    (package-version libc))
+
   (define build
     #~(begin
         (mkdir #$output)
-        (mkdir (string-append #$output "/" #$(package-version libc)))
+
+        ;; XXX: For libcs < 2.22, locale data is stored in the top-level
+        ;; directory.
+        ;; TODO: Remove this hack once libc 2.21 is buried.
+        #$(if (version>=? version "2.22")
+              #~(mkdir (string-append #$output "/" #$version))
+              #~(symlink "." (string-append #$output "/" #$version)))
 
         ;; 'localedef' executes 'gzip' to access compressed locale sources.
         (setenv "PATH" (string-append #$gzip "/bin"))
@@ -80,9 +103,38 @@ of LIBC."
          (and #$@(map (cut localedef-command <> #:libc libc)
                       locales)))))
 
-  (gexp->derivation "locale" build
+  (gexp->derivation (string-append "locale-" version) build
                     #:local-build? #t))
 
+(define* (locale-directory locales
+                           #:key (libcs %default-locale-libcs))
+  "Return a locale directory containing all of LOCALES for each libc package
+listed in LIBCS.
+
+It is useful to list more than one libc when willing to support
+already-installed packages built against a different libc since the locale
+data format changes between libc versions."
+  (match libcs
+    ((libc)
+     (single-locale-directory locales #:libc libc))
+    ((libcs ..1)
+     (mlet %store-monad ((dirs (mapm %store-monad
+                                     (lambda (libc)
+                                       (single-locale-directory locales
+                                                                #:libc libc))
+                                     libcs)))
+       (gexp->derivation "locale-multiple-versions"
+                         #~(begin
+                             (use-modules (guix build union))
+                             (union-build #$output (list #$@dirs)))
+                         #:modules '((guix build union))
+                         #:local-build? #t
+                         #:substitutable? #f)))))
+
+(define %default-locale-libcs
+  ;; The libcs for which we build locales by default.
+  (list (canonical-package glibc)))
+
 (define %default-locale-definitions
   ;; Arbitrary set of locales that are built by default.  They are here mostly
   ;; to facilitate first-time use to some people, while others may have to add
diff --git a/gnu/system/linux.scm b/gnu/system/pam.scm
index cd14bc97be..99d94a1a81 100644
--- a/gnu/system/linux.scm
+++ b/gnu/system/pam.scm
@@ -16,7 +16,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-module (gnu system linux)
+(define-module (gnu system pam)
   #:use-module (guix records)
   #:use-module (guix derivations)
   #:use-module (guix gexp)
@@ -36,8 +36,7 @@
 
 ;;; Commentary:
 ;;;
-;;; Configuration of Linux-related things, including pluggable authentication
-;;; modules (PAM).
+;;; Configuration of the pluggable authentication modules (PAM).
 ;;;
 ;;; Code:
 
@@ -129,7 +128,10 @@ dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
 (define unix-pam-service
   (let ((unix (pam-entry
                (control "required")
-               (module "pam_unix.so"))))
+               (module "pam_unix.so")))
+        (env  (pam-entry ; to honor /etc/environment.
+               (control "required")
+               (module "pam_env.so"))))
     (lambda* (name #:key allow-empty-passwords? motd)
       "Return a standard Unix-style PAM service for NAME.  When
 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords.  When MOTD is true, it
@@ -151,13 +153,13 @@ should be a file-like object used as the message-of-the-day."
                           ;; Store SHA-512 encrypted passwords in /etc/shadow.
                           (arguments '("sha512" "shadow")))))
          (session (if motd
-                      (list unix
+                      (list env unix
                             (pam-entry
                              (control "optional")
                              (module "pam_motd.so")
                              (arguments
                               (list #~(string-append "motd=" #$motd)))))
-                      (list unix))))))))
+                      (list env unix))))))))
 
 (define (rootok-pam-service command)
   "Return a PAM service for COMMAND such that 'root' does not need to
@@ -182,8 +184,7 @@ authenticate to run COMMAND."
           ;; These programs are setuid-root.
           (map (cut unix-pam-service <>
                     #:allow-empty-passwords? allow-empty-passwords?)
-               '("su" "passwd" "sudo"
-                 "xlock" "xscreensaver"))
+               '("su" "passwd" "sudo"))
 
           ;; These programs are not setuid-root, and we want root to be able
           ;; to run them without having to authenticate (notably because
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 3f49c1fc9f..7f3a1dfac2 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -280,11 +280,33 @@ group."
       (activate-users+groups (list #$@user-specs)
                              (list #$@group-specs))))
 
-(define (etc-skel arguments)
+(define (shells-file shells)
+  "Return a file-like object that builds a shell list for use as /etc/shells
+based on SHELLS.  /etc/shells is used by xterm, polkit, and other programs."
+  (computed-file "shells"
+                 #~(begin
+                     (use-modules (srfi srfi-1))
+
+                     (define shells
+                       (delete-duplicates (list #$@shells)))
+
+                     (call-with-output-file #$output
+                       (lambda (port)
+                         (display "\
+/bin/sh
+/run/current-system/profile/bin/sh
+/run/current-system/profile/bin/bash\n" port)
+                         (for-each (lambda (shell)
+                                     (display shell port)
+                                     (newline port))
+                                   shells))))))
+(define (etc-files arguments)
   "Filter out among ARGUMENTS things corresponding to skeletons, and return
 the /etc/skel directory for those."
-  (let ((skels (filter pair? arguments)))
-    `(("skel" ,(skeleton-directory skels)))))
+  (let ((skels (filter pair? arguments))
+        (users (filter user-account? arguments)))
+    `(("skel" ,(skeleton-directory skels))
+      ("shells" ,(shells-file (map user-account-shell users))))))
 
 (define account-service-type
   (service-type (name 'account)
@@ -298,7 +320,7 @@ the /etc/skel directory for those."
                  (list (service-extension activation-service-type
                                           account-activation)
                        (service-extension etc-service-type
-                                          etc-skel)))))
+                                          etc-files)))))
 
 (define (account-service accounts+groups skeletons)
   "Return a <service> that takes care of user accounts and user groups, with
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index dfb6996067..1492a0bb1c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -43,7 +43,7 @@
   #:use-module (gnu packages admin)
 
   #:use-module (gnu system shadow)
-  #:use-module (gnu system linux)
+  #:use-module (gnu system pam)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu system grub)
   #:use-module (gnu system file-systems)
@@ -92,7 +92,7 @@
                                              (system (%current-system))
                                              (linux linux-libre)
                                              initrd
-                                             (qemu qemu-headless)
+                                             (qemu qemu-minimal)
                                              (env-vars '())
                                              (modules
                                               '((gnu build vm)
@@ -185,7 +185,7 @@ made available under the /xchg CIFS share."
 (define* (qemu-image #:key
                      (name "qemu-image")
                      (system (%current-system))
-                     (qemu qemu-headless)
+                     (qemu qemu-minimal)
                      (disk-image-size (* 100 (expt 2 20)))
                      (disk-image-format "qcow2")
                      (file-system-type "ext4")