Merge branch 'master' into core-updates

7 files changed, 73 insertions, 71 deletions

diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index 7cb461f2b9..91e7d0b562 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -24,7 +24,7 @@
 
   (users (cons (user-account
                 (name "alice")
-                (comment "Bob's brother")
+                (comment "Bob's sister")
                 (group "users")
                 (supplementary-groups '("wheel" "netdev"
                                         "audio" "video"))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0dc472e3c7..b51d57f079 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -47,6 +47,7 @@
             %binary-format-file-system
             %shared-memory-file-system
             %pseudo-terminal-file-system
+            %tty-gid
             %immutable-store
             %control-groups
             %elogind-file-systems
diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm
index 45b46cae6f..ead48f0e32 100644
--- a/gnu/system/grub.scm
+++ b/gnu/system/grub.scm
@@ -62,6 +62,17 @@
 ;;;
 ;;; Code:
 
+(define (strip-mount-point fs file)
+  "Strip the mount point of FS from FILE, which is a gexp or other lowerable
+object denoting a file name."
+  (let ((mount-point (file-system-mount-point fs)))
+    (if (string=? mount-point "/")
+	file
+	#~(let ((file #$file))
+            (if (string-prefix? #$mount-point file)
+                (substring #$file #$(string-length mount-point))
+                file)))))
+
 (define-record-type* <grub-image>
   grub-image make-grub-image
   grub-image?
@@ -183,7 +194,8 @@ the store is.  SYSTEM must be the target system string---e.g.,
                      (symbol->string (assoc-ref colors 'bg)))))
 
   (define font-file
-    #~(string-append #$grub "/share/grub/unicode.pf2"))
+    (strip-mount-point root-fs
+                       (file-append grub "/share/grub/unicode.pf2")))
 
   (mlet* %store-monad ((image (grub-background-image config)))
     (return (and image
@@ -209,7 +221,7 @@ fi~%"
                            #$(grub-root-search root-fs font-file)
                            #$font-file
 
-                           #$image
+                           #$(strip-mount-point root-fs image)
                            #$(theme-colors grub-theme-color-normal)
                            #$(theme-colors grub-theme-color-highlight))))))
 
@@ -222,18 +234,23 @@ fi~%"
   "Return the GRUB 'search' command to look for ROOT-FS, which contains FILE,
 a gexp.  The result is a gexp that can be inserted in the grub.cfg-generation
 code."
-  (case (file-system-title root-fs)
-    ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
-    ;; efficient and less ambiguous, see <>.
-    ((uuid)
-     (format #f "search --fs-uuid --set ~a"
-             (uuid->string (file-system-device root-fs))))
-    ((label)
-     (format #f "search --label --set ~a"
-             (file-system-device root-fs)))
-    (else
-     ;; As a last resort, look for any device containing FILE.
-     #~(format #f "search --file --set ~a" #$file))))
+  ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
+  ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
+  ;; custom menu entries.  In the latter case, don't emit a 'search' command.
+  (if (and (string? file) (not (string-prefix? "/" file)))
+      ""
+      (case (file-system-title root-fs)
+        ;; Preferably refer to ROOT-FS by its UUID or label.  This is more
+        ;; efficient and less ambiguous, see <>.
+        ((uuid)
+         (format #f "search --fs-uuid --set ~a"
+                 (uuid->string (file-system-device root-fs))))
+        ((label)
+         (format #f "search --label --set ~a"
+                 (file-system-device root-fs)))
+        (else
+         ;; As a last resort, look for any device containing FILE.
+         #~(format #f "search --file --set ~a" #$file)))))
 
 (define* (grub-configuration-file config store-fs entries
                                   #:key
@@ -243,33 +260,34 @@ code."
 <grub-configuration> object, and where the store is available at STORE-FS, a
 <file-system> 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)))
 
   (define entry->gexp
     (match-lambda
      (($ <menu-entry> label linux arguments initrd)
-      #~(format port "menuentry ~s {
+      ;; Use the right file names for LINUX and STORE-FS in case STORE-FS is
+      ;; not the "/" file system.
+      (let ((linux  (strip-mount-point store-fs linux))
+            (initrd (strip-mount-point store-fs initrd)))
+        #~(format port "menuentry ~s {
   ~a
-  linux ~a/~a ~a
+  linux ~a ~a
   initrd ~a
 }~%"
-                #$label
-                #$(grub-root-search store-fs
-                                    #~(string-append #$linux "/"
-                                                     #$linux-image-name))
-                #$linux #$linux-image-name (string-join (list #$@arguments))
-                #$initrd))))
+                  #$label
+                  #$(grub-root-search store-fs linux)
+                  #$linux (string-join (list #$@arguments))
+                  #$initrd)))))
 
   (mlet %store-monad ((sugar (eye-candy config store-fs system #~port)))
     (define builder
       #~(call-with-output-file #$output
           (lambda (port)
+            (format port
+                    "# This file was generated from your GuixSD configuration.  Any changes
+# will be lost upon reconfiguration.
+")
             #$sugar
             (format port "
 set default=~a
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 5acfa2c65b..dfa003f256 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -268,21 +268,21 @@ You have been warned.  Thanks for being so brave.
 ")))
     (define (normal-tty tty)
       (mingetty-service (mingetty-configuration (tty tty)
-                                                (motd motd)
                                                 (auto-login "root")
                                                 (login-pause? #t))))
 
     (list (mingetty-service (mingetty-configuration
                              (tty "tty1")
-                             (motd motd)
                              (auto-login "root")))
 
+          (login-service (login-configuration
+                          (motd motd)))
+
           ;; Documentation.  The manual is in UTF-8, but
           ;; 'console-font-service' sets up Unicode support and loads a font
           ;; with all the useful glyphs like em dash and quotation marks.
           (mingetty-service (mingetty-configuration
                              (tty "tty2")
-                             (motd motd)
                              (auto-login "guest")
                              (login-program (log-to-info))))
 
@@ -313,12 +313,10 @@ You have been warned.  Thanks for being so brave.
           (cow-store-service)
 
           ;; Install Unicode support and a suitable font.
-          (console-font-service "tty1")
-          (console-font-service "tty2")
-          (console-font-service "tty3")
-          (console-font-service "tty4")
-          (console-font-service "tty5")
-          (console-font-service "tty6")
+          (service console-font-service-type
+                   (map (lambda (tty)
+                          (cons tty %default-console-font))
+                        '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
 
           ;; To facilitate copy/paste.
           (gpm-service)
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index bbaa5c0f89..174239a566 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -27,6 +27,7 @@
                 #:select (%store-prefix))
   #:use-module ((guix derivations)
                 #:select (derivation->output-path))
+  #:use-module (guix modules)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages guile)
@@ -66,10 +67,8 @@ the derivations referenced by EXP are automatically copied to the initrd."
   (mlet %store-monad ((init (gexp->script "init" exp
                                           #:guile guile)))
     (define builder
-      (with-imported-modules '((guix cpio)
-                               (guix build utils)
-                               (guix build store-copy)
-                               (gnu build linux-initrd))
+      (with-imported-modules (source-module-closure
+                              '((gnu build linux-initrd)))
         #~(begin
             (use-modules (gnu build linux-initrd))
 
@@ -88,9 +87,9 @@ the derivations referenced by EXP are automatically copied to the initrd."
   "Return a flat directory containing the Linux kernel modules listed in
 MODULES and taken from LINUX."
   (define build-exp
-    (with-imported-modules '((guix build utils)
-                             (guix elf)
-                             (gnu build linux-modules))
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (gnu build linux-modules)))
       #~(begin
           (use-modules (ice-9 match) (ice-9 regex)
                        (srfi srfi-1)
@@ -223,13 +222,11 @@ loaded at boot time in the order in which they appear."
   (mlet %store-monad ((kodir (flat-linux-module-directory linux
                                                           linux-modules)))
     (expression->initrd
-     (with-imported-modules '((guix build bournish)
-                              (guix build utils)
-                              (guix build syscalls)
-                              (gnu build linux-boot)
-                              (gnu build linux-modules)
-                              (gnu build file-systems)
-                              (guix elf))
+     (with-imported-modules (source-module-closure
+                             '((gnu build linux-boot)
+                               (guix build utils)
+                               (guix build bournish)
+                               (gnu build file-systems)))
        #~(begin
            (use-modules (gnu build linux-boot)
                         (guix build utils)
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 7b91fcfc41..2ce35eaa07 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -20,6 +20,7 @@
 (define-module (gnu system mapped-devices)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (guix modules)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:autoload   (gnu packages cryptsetup) (cryptsetup)
@@ -95,8 +96,8 @@
 (define (open-luks-device source target)
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'."
-  (with-imported-modules '((gnu build file-systems)
-                           (guix build bournish))
+  (with-imported-modules (source-module-closure
+                          '((gnu build file-systems)))
     #~(let ((source #$source))
         ;; XXX: 'use-modules' should be at the top level.
         (use-modules (rnrs bytevectors)           ;bytevector?
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index c31e3a80ef..03f7d6c913 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -26,6 +26,7 @@
   #:use-module (guix packages)
   #:use-module (guix monads)
   #:use-module (guix records)
+  #:use-module (guix modules)
 
   #:use-module ((gnu build vm)
                 #:select (qemu-command))
@@ -90,21 +91,6 @@
           (options "trans=virtio")
           (check? #f))))
 
-(define %vm-module-closure
-  ;; The closure of (gnu build vm), roughly.
-  ;; FIXME: Compute it automatically.
-  '((gnu build vm)
-    (gnu build install)
-    (gnu build linux-boot)
-    (gnu build linux-modules)
-    (gnu build file-systems)
-    (guix elf)
-    (guix records)
-    (guix build utils)
-    (guix build syscalls)
-    (guix build bournish)
-    (guix build store-copy)))
-
 (define* (expression->derivation-in-linux-vm name exp
                                              #:key
                                              (system (%current-system))
@@ -148,7 +134,8 @@ made available under the /xchg CIFS share."
 
     (define builder
       ;; Code that launches the VM that evaluates EXP.
-      (with-imported-modules %vm-module-closure
+      (with-imported-modules (source-module-closure '((guix build utils)
+                                                      (gnu build vm)))
         #~(begin
             (use-modules (guix build utils)
                          (gnu build vm))
@@ -205,7 +192,8 @@ register INPUTS in the store database of the image so that Guix can be used in
 the image."
   (expression->derivation-in-linux-vm
    name
-   (with-imported-modules %vm-module-closure
+   (with-imported-modules (source-module-closure '((gnu build vm)
+                                                   (guix build utils)))
      #~(begin
          (use-modules (gnu build vm)
                       (guix build utils))
@@ -462,7 +450,6 @@ with '-virtfs' options for the host file systems listed in SHARED-FS."
            "")
      " -no-reboot -net nic,model=virtio \
   " #$@(map virtfs-option shared-fs) " \
-  -net user \
   -vga std \
   -drive file=" #$image
   ",if=virtio,cache=writeback,werror=report,readonly \