Merge branch 'master' into core-updates

19 files changed, 695 insertions, 175 deletions

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index e1c62f5ce0..855b640030 100644
--- a/gnu/installer/final.scm
+++ b/gnu/installer/final.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,17 +21,98 @@
   #:use-module (gnu installer newt page)
   #:use-module (gnu installer steps)
   #:use-module (gnu installer utils)
+  #:use-module (gnu installer user)
   #:use-module (gnu services herd)
   #:use-module (guix build utils)
+  #:use-module (gnu build accounts)
+  #:use-module ((gnu system shadow) #:prefix sys:)
+  #:use-module (rnrs io ports)
   #:export (install-system))
 
-(define (install-system)
-  "Start COW-STORE service on target directory and launch guix install command
-in a subshell."
+(define %seed
+  (seed->random-state
+   (logxor (getpid) (car (gettimeofday)))))
+
+(define (integer->alphanumeric-char n)
+  "Map N, an integer in the [0..62] range, to an alphanumeric character."
+  (cond ((< n 10)
+         (integer->char (+ (char->integer #\0) n)))
+        ((< n 36)
+         (integer->char (+ (char->integer #\A) (- n 10))))
+        ((< n 62)
+         (integer->char (+ (char->integer #\a) (- n 36))))
+        (else
+         (error "integer out of bounds" n))))
+
+(define (random-string len)
+  "Compute a random string of size LEN where each character is alphanumeric."
+  (let loop ((chars '())
+             (len len))
+    (if (zero? len)
+        (list->string chars)
+        (let ((n (random 62 %seed)))
+          (loop (cons (integer->alphanumeric-char n) chars)
+                (- len 1))))))
+
+(define (create-user-database users root)
+  "Create /etc/passwd, /etc/shadow, and /etc/group under ROOT for the given
+USERS."
+  (define etc
+    (string-append root "/etc"))
+
+  (define (salt)
+    ;; "$6" gives us a SHA512 password hash; the random string must be taken
+    ;; from the './0-9A-Za-z' alphabet (info "(libc) Passphrase Storage").
+    (string-append "$6$" (random-string 10)))
+
+  (define users*
+    (map (lambda (user)
+           (define root?
+             (string=? "root" (user-name user)))
+
+           (sys:user-account (name (user-name user))
+                             (comment (user-real-name user))
+                             (group "users")
+                             (uid (if root? 0 #f))
+                             (home-directory
+                              (user-home-directory user))
+                             (password (crypt (user-password user)
+                                              (salt)))
+
+                             ;; We need a string here, not a file-like, hence
+                             ;; this choice.
+                             (shell
+                              "/run/current-system/profile/bin/bash")))
+         users))
+
+  (define-values (group password shadow)
+    (user+group-databases users* sys:%base-groups
+                          #:current-passwd '()
+                          #:current-groups '()
+                          #:current-shadow '()))
+
+  (mkdir-p etc)
+  (write-group group (string-append etc "/group"))
+  (write-passwd password (string-append etc "/passwd"))
+  (write-shadow shadow (string-append etc "/shadow")))
+
+(define* (install-system locale #:key (users '()))
+  "Create /etc/shadow and /etc/passwd on the installation target for USERS.
+Start COW-STORE service on target directory and launch guix install command in
+a subshell.  LOCALE must be the locale name under which that command will run,
+or #f.  Return #t on success and #f on failure."
   (let ((install-command
          (format #f "guix system init ~a ~a"
                  (%installer-configuration-file)
                  (%installer-target-dir))))
     (mkdir-p (%installer-target-dir))
+
+    ;; We want to initialize user passwords but we don't want to store them in
+    ;; the config file since the password hashes would end up world-readable
+    ;; in the store.  Thus, create /etc/shadow & co. here such that, on the
+    ;; first boot, the activation snippet that creates accounts will reuse the
+    ;; passwords that we've put in there.
+    (create-user-database users (%installer-target-dir))
+
     (start-service 'cow-store (list (%installer-target-dir)))
-    (false-if-exception (run-shell-command install-command))))
+    (run-shell-command install-command #:locale locale)))
diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
index d66b376d9c..df9fc5e441 100644
--- a/gnu/installer/keymap.scm
+++ b/gnu/installer/keymap.scm
@@ -36,6 +36,7 @@
             make-x11-keymap-layout
             x11-keymap-layout?
             x11-keymap-layout-name
+            x11-keymap-layout-synopsis
             x11-keymap-layout-description
             x11-keymap-layout-variants
 
@@ -60,7 +61,8 @@
   x11-keymap-layout make-x11-keymap-layout
   x11-keymap-layout?
   (name            x11-keymap-layout-name) ;string
-  (description     x11-keymap-layout-description) ;string
+  (synopsis        x11-keymap-layout-synopsis)    ;string (e.g., "en")
+  (description     x11-keymap-layout-description) ;string (a whole phrase)
   (variants        x11-keymap-layout-variants)) ;list of <x11-keymap-variant>
 
 (define-record-type* <x11-keymap-variant>
@@ -117,6 +119,8 @@ Configuration Database, describing possible XKB configurations."
                   (variantList ,[variant -> v] ...))
                  (x11-keymap-layout
                   (name name)
+                  (synopsis (car
+                             (assoc-ref rest-layout 'shortDescription)))
                   (description (car
                                 (assoc-ref rest-layout 'description)))
                   (variants (list v ...)))]
@@ -126,6 +130,8 @@ Configuration Database, describing possible XKB configurations."
                    . ,rest-layout))
                  (x11-keymap-layout
                   (name name)
+                  (synopsis (car
+                             (assoc-ref rest-layout 'shortDescription)))
                   (description (car
                                 (assoc-ref rest-layout 'description)))
                   (variants '()))]))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 2b45b2200a..284062a6e7 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -69,6 +70,24 @@
       (codeset   . ,(match:substring matches 5))
       (modifier  . ,(match:substring matches 7)))))
 
+(define (normalize-codeset codeset)
+  "Compute the \"normalized\" variant of CODESET."
+  ;; info "(libc) Using gettextized software", for the algorithm used to
+  ;; compute the normalized codeset.
+  (letrec-syntax ((-> (syntax-rules ()
+                        ((_ proc value)
+                         (proc value))
+                        ((_ proc rest ...)
+                         (proc (-> rest ...))))))
+    (-> (lambda (str)
+          (if (string-every char-set:digit str)
+              (string-append "iso" str)
+              str))
+        string-downcase
+        (lambda (str)
+          (string-filter char-set:letter+digit str))
+        codeset)))
+
 (define (locale->locale-string locale)
   "Reverse operation of locale-string->locale."
   (let ((language (locale-language locale))
@@ -81,7 +100,7 @@
                    `("_" ,territory)
                    '())
              ,@(if codeset
-                   `("." ,codeset)
+                   `("." ,(normalize-codeset codeset))
                    '())
              ,@(if modifier
                    `("@" ,modifier)
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 645c1e8689..e375282613 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,15 +30,24 @@
   #:use-module (newt)
   #:export (run-final-page))
 
+(define* (strip-prefix file #:optional (prefix (%installer-target-dir)))
+  "Strip PREFIX from FILE, if PREFIX actually is a prefix of FILE."
+  (if (string-prefix? prefix file)
+      (string-drop file (string-length prefix))
+      file))
+
 (define (run-config-display-page)
   (let ((width (%configuration-file-width))
         (height (nearest-exact-integer
                  (/ (screen-rows) 2))))
     (run-file-textbox-page
-     #:info-text (G_ "We're now ready to proceed with the installation! \
+     #:info-text (format #f (G_ "\
+We're now ready to proceed with the installation! \
 A system configuration file has been generated, it is displayed below.  \
+This file will be available as '~a' on the installed system.  \
 The new system will be created from this file once you've pressed OK.  \
 This will take a few minutes.")
+                         (strip-prefix (%installer-configuration-file)))
      #:title (G_ "Configuration file")
      #:file (%installer-configuration-file)
      #:info-textbox-width width
@@ -55,7 +65,10 @@ This will take a few minutes.")
    (G_ "Reboot")
    (G_ "Congratulations!  Installation is now complete.  \
 You may remove the device containing the installation image and \
-press the button to reboot.")))
+press the button to reboot."))
+
+  ;; Return success so that the installer happily reboots.
+  'success)
 
 (define (run-install-failed-page)
   (choice-window
@@ -65,22 +78,25 @@ press the button to reboot.")))
    (G_ "The final system installation step failed.  You can retry the \
 last step, or restart the installer.")))
 
-(define (run-install-shell)
+(define* (run-install-shell locale
+                            #:key (users '()))
   (clear-screen)
   (newt-suspend)
-  (let ((install-ok? (install-system)))
+  (let ((install-ok? (install-system locale #:users users)))
     (newt-resume)
     install-ok?))
 
 (define (run-final-page result prev-steps)
-  (let* ((configuration (format-configuration prev-steps result))
+  (let* ((configuration   (format-configuration prev-steps result))
          (user-partitions (result-step result 'partition))
+         (locale          (result-step result 'locale))
+         (users           (result-step result 'user))
          (install-ok?
           (with-mounted-partitions
            user-partitions
            (configuration->file configuration)
            (run-config-display-page)
-           (run-install-shell))))
+           (run-install-shell locale #:users users))))
     (if install-ok?
         (run-install-success-page)
         (run-install-failed-page))))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
index 3e765bfdd4..2908ba7f0e 100644
--- a/gnu/installer/newt/keymap.scm
+++ b/gnu/installer/newt/keymap.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -27,7 +28,10 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
-  #:export (run-keymap-page))
+  #:use-module (ice-9 i18n)
+  #:use-module (ice-9 match)
+  #:export (run-keymap-page
+            keyboard-layout->configuration))
 
 (define (run-layout-page layouts layout->text)
   (let ((title (G_ "Layout")))
@@ -61,14 +65,29 @@
 
 (define (sort-layouts layouts)
   "Sort LAYOUTS list by putting the US layout ahead and return it."
+  (define (layout<? layout1 layout2)
+    (let ((text1 (x11-keymap-layout-description layout1))
+          (text2 (x11-keymap-layout-description layout2)))
+      ;; XXX: We're calling 'gettext' more than once per item.
+      (string-locale<? (gettext text1 "xkeyboard-config")
+                       (gettext text2 "xkeyboard-config"))))
+
+  (define preferred
+    ;; Two-letter language tag for the preferred keyboard layout.
+    (or (getenv "LANGUAGE") "us"))
+
   (call-with-values
       (lambda ()
         (partition
          (lambda (layout)
-           (let ((name (x11-keymap-layout-name layout)))
-             (string=? name "us")))
+           ;; The 'synopsis' field is usually a language code (e.g., "en")
+           ;; while the 'name' field is a country code (e.g., "us").
+           (or (string=? (x11-keymap-layout-name layout) preferred)
+               (string=? (x11-keymap-layout-synopsis layout) preferred)))
          layouts))
-    (cut append <> <>)))
+    (lambda (main others)
+      (append (sort main layout<?)
+              (sort others layout<?)))))
 
 (define (sort-variants variants)
   "Sort VARIANTS list by putting the international variant ahead and return it."
@@ -94,7 +113,8 @@ names of the selected keyboard layout and variant."
          (run-layout-page
           (sort-layouts layouts)
           (lambda (layout)
-            (x11-keymap-layout-description layout))))))
+            (gettext (x11-keymap-layout-description layout)
+                     "xkeyboard-config"))))))
      ;; Propose the user to select a variant among those supported by the
      ;; previously selected layout.
      (installer-step
@@ -108,15 +128,24 @@ names of the selected keyboard layout and variant."
                 (run-variant-page
                  (sort-variants variants)
                  (lambda (variant)
-                   (x11-keymap-variant-description
-                    variant))))))))))
+                   (gettext (x11-keymap-variant-description variant)
+                            "xkeyboard-config"))))))))))
 
   (define (format-result result)
     (let ((layout (x11-keymap-layout-name
                    (result-step result 'layout)))
           (variant (and=> (result-step result 'variant)
                           (lambda (variant)
-                            (x11-keymap-variant-name variant)))))
+                            (gettext (x11-keymap-variant-name variant)
+                                     "xkeyboard-config")))))
       (list layout (or variant ""))))
   (format-result
    (run-installer-steps #:steps keymap-steps)))
+
+(define (keyboard-layout->configuration keymap)
+  "Return the operating system configuration snippet to install KEYMAP."
+  (match keymap
+    ((name "")
+     `((keyboard-layout (keyboard-layout ,name))))
+    ((name variant)
+     `((keyboard-layout (keyboard-layout ,name ,variant))))))
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
index 4fa07df81e..7108e2960b 100644
--- a/gnu/installer/newt/locale.scm
+++ b/gnu/installer/newt/locale.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,17 +31,11 @@
   #:export (run-locale-page))
 
 (define (run-language-page languages language->text)
-  (let ((title (G_ "Locale language")))
+  (define result
     (run-listbox-selection-page
-     #:title title
-     #:info-text (G_ "Choose the locale's language to be used for the \
-installation process. A locale is a regional variant of your language \
-encompassing number, date and currency format, among other details.
-
-Based on the language you choose, you will possibly be asked to \
-select a locale's territory, codeset and modifier in the next \
-steps. The locale will also be used as the default one for the \
-installed system.")
+     #:title (G_ "Locale language")
+     #:info-text (G_ "Choose the language to use for the \
+installation process and for the installed system.")
      #:info-textbox-width 70
      #:listbox-items languages
      #:listbox-item->text language->text
@@ -50,14 +45,19 @@ installed system.")
      (lambda _
        (raise
         (condition
-         (&installer-step-abort)))))))
+         (&installer-step-abort))))))
+
+  ;; Immediately install the chosen language so that the territory page that
+  ;; comes after (optionally) is displayed in the chosen language.
+  (setenv "LANGUAGE" result)
+
+  result)
 
 (define (run-territory-page territories territory->text)
   (let ((title (G_ "Locale location")))
     (run-listbox-selection-page
      #:title title
-     #:info-text (G_ "Choose your locale's location. This is a shortlist of \
-locations based on the language you selected.")
+     #:info-text (G_ "Choose a territory for this language.")
      #:listbox-items territories
      #:listbox-item->text territory->text
      #:button-text (G_ "Back")
@@ -71,8 +71,7 @@ locations based on the language you selected.")
   (let ((title (G_ "Locale codeset")))
     (run-listbox-selection-page
      #:title title
-     #:info-text (G_ "Choose your locale's codeset. If UTF-8 is available, \
- it should be preferred.")
+     #:info-text (G_ "Choose the locale encoding.")
      #:listbox-items codesets
      #:listbox-item->text identity
      #:listbox-default-item "UTF-8"
@@ -163,7 +162,13 @@ glibc locale string and return it."
          (run-language-page
           (sort-languages
            (delete-duplicates (map locale-language supported-locales)))
-          (cut language-code->language-name iso639-languages <>)))))
+          (lambda (language)
+            (let ((english (language-code->language-name iso639-languages
+                                                         language)))
+              (setenv "LANGUAGE" language)
+              (let ((native (gettext english "iso_639-3")))
+                (unsetenv "LANGUAGE")
+                native)))))))
      (installer-step
       (id 'territory)
       (compute
@@ -177,10 +182,11 @@ glibc locale string and return it."
            ;; supported by the previously selected language.
            (run-territory-page
             (delete-duplicates (map locale-territory locales))
-            (lambda (territory-code)
-              (if territory-code
-                  (territory-code->territory-name iso3166-territories
-                                                  territory-code)
+            (lambda (territory)
+              (if territory
+                  (let ((english (territory-code->territory-name
+                                  iso3166-territories territory)))
+                    (gettext english "iso_3166-1"))
                   (G_ "No location"))))))))
      (installer-step
       (id 'codeset)
@@ -191,9 +197,11 @@ glibc locale string and return it."
            ;; narrow down the search of a locale.
            (break-on-locale-found locales)
 
-           ;; Otherwise, ask for a codeset.
-           (run-codeset-page
-            (delete-duplicates (map locale-codeset locales)))))))
+           ;; Otherwise, choose a codeset.
+           (let ((codesets (delete-duplicates (map locale-codeset locales))))
+             (if (member "UTF-8" codesets)
+                 "UTF-8"                          ;don't even ask
+                 (run-codeset-page codesets)))))))
      (installer-step
       (id 'modifier)
       (compute
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index f13176dc61..cf27a8cca2 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -59,7 +59,7 @@ Internet and return the selected technology. For now, only technologies with
                (G_ "Internet access")
                (G_ "Continue")
                (G_ "Exit")
-               (G_ "The install process requires an internet access, but no \
+               (G_ "The install process requires Internet access but no \
 network device were found. Do you want to continue anyway?"))
           ((1) (raise
                 (condition
@@ -68,7 +68,7 @@ network device were found. Do you want to continue anyway?"))
                 (condition
                  (&installer-step-abort)))))
         (run-listbox-selection-page
-         #:info-text (G_ "The install process requires an internet access.\
+         #:info-text (G_ "The install process requires Internet access.\
  Please select a network device.")
          #:title (G_ "Internet access")
          #:listbox-items items
@@ -93,7 +93,8 @@ network device were found. Do you want to continue anyway?"))
         (full-value 5))
     (run-scale-page
      #:title (G_ "Powering technology")
-     #:info-text (format #f "Waiting for technology ~a to be powered." name)
+     #:info-text (format #f (G_ "Waiting for technology ~a to be powered.")
+                         name)
      #:scale-full-value full-value
      #:scale-update-proc
      (lambda (value)
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 23fbfcce76..3173d54737 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
   #:use-module (gnu installer utils)
   #:use-module (gnu installer newt utils)
   #:use-module (guix i18n)
+  #:use-module (ice-9 i18n)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
   #:use-module (srfi srfi-1)
@@ -29,6 +31,7 @@
             draw-connecting-page
             run-input-page
             run-error-page
+            run-confirmation-page
             run-listbox-selection-page
             run-scale-page
             run-checkbox-tree-page
@@ -72,17 +75,20 @@ this page to TITLE."
                          #:key
                          (allow-empty-input? #f)
                          (default-text #f)
-                         (input-field-width 40))
+                         (input-field-width 40)
+                         (input-flags 0))
   "Run a page to prompt user for an input. The given TEXT will be displayed
 above the input field. The page title is set to TITLE. Unless
 allow-empty-input? is set to #t, an error page will be displayed if the user
-enters an empty input."
+enters an empty input.  INPUT-FLAGS is a bitwise-or'd set of flags for the
+input box, such as FLAG-PASSWORD."
   (let* ((text-box
           (make-reflowed-textbox -1 -1 text
                                  input-field-width
                                  #:flags FLAG-BORDER))
          (grid (make-grid 1 3))
-         (input-entry (make-entry -1 -1 20))
+         (input-entry (make-entry -1 -1 20
+                                  #:flags input-flags))
          (ok-button (make-button -1 -1 (G_ "OK")))
          (form (make-form)))
 
@@ -141,6 +147,42 @@ of the page is set to TITLE."
     (newt-set-color COLORSET-ROOT "white" "blue")
     (destroy-form-and-pop form)))
 
+(define* (run-confirmation-page text title
+                                #:key (exit-button-procedure (const #f)))
+  "Run a page to inform the user of an error. The page contains the given TEXT
+to explain the error and an \"OK\" button to acknowledge the error. The title
+of the page is set to TITLE."
+  (let* ((text-box
+          (make-reflowed-textbox -1 -1 text 40
+                                 #:flags FLAG-BORDER))
+         (ok-button (make-button -1 -1 (G_ "Continue")))
+         (exit-button (make-button -1 -1 (G_ "Exit")))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT text-box
+                GRID-ELEMENT-SUBGRID
+                (horizontal-stacked-grid
+                 GRID-ELEMENT-COMPONENT ok-button
+                 GRID-ELEMENT-COMPONENT exit-button)))
+         (form (make-form)))
+
+    (add-form-to-grid grid form #t)
+    (make-wrapped-grid-window grid title)
+
+    (receive (exit-reason argument)
+        (run-form form)
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (case exit-reason
+            ((exit-component)
+             (cond
+              ((components=? argument ok-button)
+               #t)
+              ((components=? argument exit-button)
+               (exit-button-procedure))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
 (define* (run-listbox-selection-page #:key
                                      info-text
                                      title
@@ -185,7 +227,7 @@ be selected (using the <SPACE> key). It that case, a list containing the
 selected items will be returned.
 
 If SORT-LISTBOX-ITEMS? is set to #t, the listbox items are sorted using
-'string<=' procedure (after being converted to text).
+'string-locale<?' procedure (after being converted to text).
 
 If ALLOW-DELETE? is #t, the form will return if the <DELETE> key is pressed,
 otherwise nothing will happen.
@@ -211,7 +253,7 @@ ITEM was inserted into LISTBOX."
          items))
 
   (define (sort-listbox-items listbox-items)
-    "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text
+    "Return LISTBOX-ITEMS sorted using the 'string-locale<?' procedure on the text
 corresponding to each item in the list."
     (let* ((items (map (lambda (item)
                          (cons item (listbox-item->text item)))
@@ -220,7 +262,7 @@ corresponding to each item in the list."
             (sort items (lambda (a b)
                           (let ((text-a (cdr a))
                                 (text-b (cdr b)))
-                            (string<= text-a text-b))))))
+                            (string-locale<? text-a text-b))))))
       (map car sorted-items)))
 
   ;; Store the last selected listbox item's key.
@@ -395,10 +437,14 @@ error is raised if the MAX-SCALE-UPDATE limit is reached."
       (lambda ()
         (destroy-form-and-pop form)))))
 
+(define %none-selected
+  (circular-list #f))
+
 (define* (run-checkbox-tree-page #:key
                                  info-text
                                  title
                                  items
+                                 (selection %none-selected)
                                  item->text
                                  (info-textbox-width 50)
                                  (checkbox-tree-height 10)
@@ -411,7 +457,8 @@ a checkbox list. The page contains vertically stacked from the top to the
 bottom, an informative text set to INFO-TEXT, the checkbox list and two
 buttons, 'Ok' and 'Exit'. The page title's is set to TITLE. ITEMS are
 converted to text using ITEM->TEXT before being displayed in the checkbox
-list.
+list.  SELECTION is a list of Booleans of the same length as ITEMS that
+specifies which items are initially checked.
 
 INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be
 displayed. CHECKBOX-TREE-HEIGHT is the height of the checkbox list.
@@ -423,12 +470,15 @@ pressed.
 This procedure returns the list of checked items in the checkbox list among
 ITEMS when 'Ok' is pressed."
   (define (fill-checkbox-tree checkbox-tree items)
-    (map
-     (lambda (item)
-       (let* ((item-text (item->text item))
-              (key (add-entry-to-checkboxtree checkbox-tree item-text 0)))
-         (cons key item)))
-     items))
+    (map (lambda (item selected?)
+           (let* ((item-text (item->text item))
+                  (key (add-entry-to-checkboxtree checkbox-tree item-text
+                                                  (if selected?
+                                                      FLAG-SELECTED
+                                                      0))))
+             (cons key item)))
+         items
+         selection))
 
   (let* ((checkbox-tree
           (make-checkboxtree -1 -1
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index d4c91edc66..2b22ac85b4 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,8 +42,8 @@
 (define (run-scheme-page)
   "Run a page asking the user for a partitioning scheme."
   (let* ((items
-          '((root . "Everything is one partition")
-            (root-home . "Separate /home partition")))
+          `((root . ,(G_ "Everything is one partition"))
+            (root-home . ,(G_ "Separate /home partition"))))
          (result (run-listbox-selection-page
                   #:info-text (G_ "Please select a partitioning scheme.")
                   #:title (G_ "Partition scheme")
@@ -53,7 +54,12 @@
     (car result)))
 
 (define (draw-formatting-page)
-  "Draw a page to indicate partitions are being formated."
+  "Draw a page asking for confirmation, and then indicating that partitions
+are being formatted."
+  (run-confirmation-page (G_ "We are about to format your hard disk.  All \
+its data will be lost.  Do you wish to continue?")
+                         (G_ "Format disk?")
+                         #:exit-button-procedure button-exit-action)
   (draw-info-page
    (format #f (G_ "Partition formatting is in progress, please wait."))
    (G_ "Preparing partitions")))
@@ -146,6 +152,10 @@ USER-PARTITIONS list. Return this list with password fields filled-in."
                 (file-name (user-partition-file-name user-part))
                 (password-page
                  (lambda ()
+                   ;; Note: Don't use FLAG-PASSWORD here because this is the
+                   ;; first bit of text that the user types in, so it's
+                   ;; probably safer if they can see that the keyboard layout
+                   ;; they chose is in effect.
                    (run-input-page
                     (format #f (G_ "Please enter the password for the \
 encryption of partition ~a (label: ~a).") file-name crypt-label)
@@ -155,7 +165,8 @@ encryption of partition ~a (label: ~a).") file-name crypt-label)
                    (run-input-page
                     (format #f (G_ "Please confirm the password for the \
 encryption of partition ~a (label: ~a).") file-name crypt-label)
-                    (G_ "Password confirmation required")))))
+                    (G_ "Password confirmation required")
+                    #:input-flags FLAG-PASSWORD))))
            (if crypt-label
                (let loop ()
                  (let ((password (password-page))
@@ -418,10 +429,10 @@ partition. Leave this field empty if you don't want to set a mounting point.")
           (run-listbox-selection-page
            #:info-text
            (if creation?
-               (G_ (format #f "Creating ~a partition starting at ~a of ~a."
-                           type-str start file-name))
-               (G_ (format #f "You are currently editing partition ~a."
-                           number-str)))
+               (format #f (G_ "Creating ~a partition starting at ~a of ~a.")
+                       type-str start file-name)
+               (format #f (G_ "You are currently editing partition ~a.")
+                       number-str))
            #:title (if creation?
                        (G_ "Partition creation")
                        (G_ "Partition edit"))
@@ -662,7 +673,8 @@ by pressing the Exit button.~%~%")))
           #:title (if guided?
                       (G_ "Guided partitioning")
                       (G_ "Manual partitioning"))
-          #:info-textbox-width 70
+          #:info-textbox-width 76         ;we need a lot of room for INFO-TEXT
+          #:listbox-height 12
           #:listbox-items (disk-items)
           #:listbox-item->text cdr
           #:sort-listbox-items? #f
@@ -713,9 +725,9 @@ by pressing the Exit button.~%~%")))
   "Run a page asking the user for a partitioning method."
   (define (run-page devices)
     (let* ((items
-            '((entire . "Guided - using the entire disk")
-              (entire-encrypted . "Guided - using the entire disk with encryption")
-              (manual . "Manual")))
+            `((entire . ,(G_ "Guided - using the entire disk"))
+              (entire-encrypted . ,(G_ "Guided - using the entire disk with encryption"))
+              (manual . ,(G_ "Manual"))))
            (result (run-listbox-selection-page
                     #:info-text (G_ "Please select a partitioning method.")
                     #:title (G_ "Partitioning method")
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
index 6bcb6244ae..4f32d9077b 100644
--- a/gnu/installer/newt/services.scm
+++ b/gnu/installer/newt/services.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,19 +31,70 @@
 (define (run-desktop-environments-cbt-page)
   "Run a page allowing the user to choose between various desktop
 environments."
-  (run-checkbox-tree-page
-   #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
-install. If you select multiple desktops environments, we will be able to \
-choose the one to use on the log-in screen with F1.")
-   #:title (G_ "Desktop environment")
-   #:items %desktop-environments
-   #:item->text desktop-environment-name
-   #:checkbox-tree-height 5
-   #:exit-button-callback-procedure
-   (lambda ()
-     (raise
-      (condition
-       (&installer-step-abort))))))
+  (let ((items (filter desktop-system-service? %system-services)))
+    (run-checkbox-tree-page
+     #:info-text (G_ "Please select the desktop(s) environment(s) you wish to \
+install. If you select multiple desktops environments, you will be able to \
+choose the one to use on the log-in screen.")
+     #:title (G_ "Desktop environment")
+     #:items items
+     #:selection (map system-service-recommended? items)
+     #:item->text system-service-name             ;no i18n for DE names
+     #:checkbox-tree-height 8
+     #:exit-button-callback-procedure
+     (lambda ()
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-networking-cbt-page)
+  "Run a page allowing the user to select networking services."
+  (let ((items (filter (lambda (service)
+                         (eq? 'networking (system-service-type service)))
+                       %system-services)))
+    (run-checkbox-tree-page
+     #:info-text (G_ "You can now select networking services to run on your \
+system.")
+     #:title (G_ "Network service")
+     #:items items
+     #:selection (map system-service-recommended? items)
+     #:item->text (compose G_ system-service-name)
+     #:checkbox-tree-height 5
+     #:exit-button-callback-procedure
+     (lambda ()
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-network-management-page)
+  "Run a page to select among several network management methods."
+  (let ((title (G_ "Network management")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose the method to manage network connections.
+
+We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \
+client may be enough for a server.")
+     #:info-textbox-width 70
+     #:listbox-items (filter (lambda (service)
+                               (eq? 'network-management
+                                    (system-service-type service)))
+                             %system-services)
+     #:listbox-item->text (compose G_ system-service-name)
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Exit")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
 
 (define (run-services-page)
-  (run-desktop-environments-cbt-page))
+  (let ((desktop (run-desktop-environments-cbt-page)))
+    ;; When the user did not select any desktop services, and thus didn't get
+    ;; '%desktop-services', offer network management services.
+    (append desktop
+            (run-networking-cbt-page)
+            (if (null? desktop)
+                (list (run-network-management-page))
+                '()))))
diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm
index 63b44af729..67bf41ff84 100644
--- a/gnu/installer/newt/timezone.scm
+++ b/gnu/installer/newt/timezone.scm
@@ -50,12 +50,15 @@ returned."
 
   (define (run-page timezone-tree)
     (define (loop path)
+      ;; XXX: Translation of time zones isn't perfect here because the
+      ;; "iso_3166-1" domain contains translation for "territories" (like
+      ;; "Antarctic") but not for continents (like "Africa").
       (let ((timezones (locate-children timezone-tree path)))
         (run-listbox-selection-page
          #:title (G_ "Timezone")
          #:info-text (G_ "Please select a timezone.")
          #:listbox-items timezones
-         #:listbox-item->text identity
+         #:listbox-item->text (cut gettext <> "iso_3166-1")
          #:button-text (if (null? path)
                            (G_ "Exit")
                            (G_ "Back"))
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index 59b1913cfc..deab056e0c 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,18 +29,31 @@
   #:use-module (srfi srfi-26)
   #:export (run-user-page))
 
-(define (run-user-add-page)
+(define* (run-user-add-page #:key (name "") (real-name "")
+                            (home-directory ""))
+  "Run a form to enter the user name, home directory, and password.  Use NAME,
+REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
   (define (pad-label label)
     (string-pad-right label 20))
 
   (let* ((label-name
           (make-label -1 -1 (pad-label (G_ "Name"))))
+         (label-real-name
+          (make-label -1 -1 (pad-label (G_ "Real name"))))
          (label-home-directory
           (make-label -1 -1 (pad-label (G_ "Home directory"))))
+         (label-password
+          (make-label -1 -1 (pad-label (G_ "Password"))))
          (entry-width 30)
-         (entry-name (make-entry -1 -1 entry-width))
-         (entry-home-directory (make-entry -1 -1 entry-width))
-         (entry-grid (make-grid 2 2))
+         (entry-name (make-entry -1 -1 entry-width
+                                 #:initial-value name))
+         (entry-real-name (make-entry -1 -1 entry-width
+                                      #:initial-value real-name))
+         (entry-home-directory (make-entry -1 -1 entry-width
+                                           #:initial-value home-directory))
+         (entry-password (make-entry -1 -1 entry-width
+                                     #:flags FLAG-PASSWORD))
+         (entry-grid (make-grid 2 5))
          (button-grid (make-grid 1 1))
          (ok-button (make-button -1 -1 (G_ "OK")))
          (grid (make-grid 1 2))
@@ -50,8 +64,12 @@
 
     (set-entry-grid-field 0 0 label-name)
     (set-entry-grid-field 1 0 entry-name)
-    (set-entry-grid-field 0 1 label-home-directory)
-    (set-entry-grid-field 1 1 entry-home-directory)
+    (set-entry-grid-field 0 1 label-real-name)
+    (set-entry-grid-field 1 1 entry-real-name)
+    (set-entry-grid-field 0 2 label-home-directory)
+    (set-entry-grid-field 1 2 entry-home-directory)
+    (set-entry-grid-field 0 3 label-password)
+    (set-entry-grid-field 1 3 entry-password)
 
     (set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button)
 
@@ -59,11 +77,17 @@
      entry-name
      (lambda (component)
        (set-entry-text entry-home-directory
-                       (string-append "/home/" (entry-value entry-name)))))
+                       (string-append "/home/" (entry-value entry-name)))
+
+       (when (string-null? (entry-value entry-real-name))
+         (set-entry-text entry-real-name
+                         (string-titlecase (entry-value entry-name))))))
 
     (add-components-to-form form
-                            label-name label-home-directory
-                            entry-name entry-home-directory
+                            label-name label-real-name
+                            label-home-directory label-password
+                            entry-name entry-real-name
+                            entry-home-directory entry-password
                             ok-button)
 
     (make-wrapped-grid-window (vertically-stacked-grid
@@ -82,19 +106,57 @@
             (when (eq? exit-reason 'exit-component)
               (cond
                ((components=? argument ok-button)
-                (let ((name (entry-value entry-name))
-                      (home-directory (entry-value entry-home-directory)))
+                (let ((name           (entry-value entry-name))
+                      (real-name      (entry-value entry-real-name))
+                      (home-directory (entry-value entry-home-directory))
+                      (password       (entry-value entry-password)))
                   (if (or (string=? name "")
                           (string=? home-directory ""))
                       (begin
                         (error-page)
                         (run-user-add-page))
-                      (user
-                       (name name)
-                       (home-directory home-directory))))))))
+                      (let ((password (confirm-password password)))
+                        (if password
+                            (user
+                             (name name)
+                             (real-name real-name)
+                             (home-directory home-directory)
+                             (password password))
+                            (run-user-add-page #:name name
+                                               #:real-name real-name
+                                               #:home-directory
+                                               home-directory)))))))))
           (lambda ()
             (destroy-form-and-pop form)))))))
 
+(define* (confirm-password password #:optional (try-again (const #f)))
+  "Ask the user to confirm PASSWORD, a possibly empty string.  Call TRY-AGAIN,
+a thunk, if the confirmation doesn't match PASSWORD, and return its result."
+  (define confirmation
+    (run-input-page (G_ "Please confirm the password.")
+                    (G_ "Password confirmation required")
+                    #:allow-empty-input? #t
+                    #:input-flags FLAG-PASSWORD))
+
+  (if (string=? password confirmation)
+      password
+      (begin
+        (run-error-page
+         (G_ "Password mismatch, please try again.")
+         (G_ "Password error"))
+        (try-again))))
+
+(define (run-root-password-page)
+  ;; TRANSLATORS: Leave "root" untranslated: it refers to the name of the
+  ;; system administrator account.
+  (define password
+    (run-input-page (G_ "Please choose a password for the system \
+administrator (\"root\").")
+                    (G_ "System administrator password")
+                    #:input-flags FLAG-PASSWORD))
+
+  (confirm-password password run-root-password-page))
+
 (define (run-user-page)
   (define (run users)
     (let* ((listbox (make-listbox
@@ -169,7 +231,12 @@
                   (run-error-page (G_ "Please create at least one user.")
                                   (G_ "No user"))
                   (run users))
-                users))))
+                (reverse users)))))
           (lambda ()
             (destroy-form-and-pop form))))))
-  (run '()))
+
+  ;; Add a "root" user simply to convey the root password.
+  (cons (user (name "root")
+              (home-directory "/root")
+              (password (run-root-password-page)))
+        (run '())))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
index b0b5429c0f..aec3e7a612 100644
--- a/gnu/installer/newt/welcome.scm
+++ b/gnu/installer/newt/welcome.scm
@@ -95,9 +95,11 @@ installation and reboot."
    (G_ "GNU Guix install")
    (G_ "Welcome to GNU Guix system installer!
 
-Please note that the present graphical installer is still under heavy \
-development, so you might want to prefer using the shell based process. \
-The documentation is accessible at any time by pressing CTRL-ALT-F2.")
+You will be guided through a graphical installation program.
+
+If you are familiar with GNU/Linux and you want tight control over \
+the installation process, you can instead choose manual installation.  \
+Documentation is accessible at any time by pressing Ctrl-Alt-F2.")
    logo
    #:listbox-items
    `((,(G_ "Graphical install using a terminal based interface")
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
index 4cf5c128e7..da2f0b56d0 100644
--- a/gnu/installer/newt/wifi.scm
+++ b/gnu/installer/newt/wifi.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo@riseup.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,7 +81,7 @@ nmc_wifi_strength_bars."
                  (message (G_ "Unable to find a wifi technology"))))))))
 
 (define (draw-scanning-page)
-  "Draw a page to indicate a wifi scan in in progress."
+  "Draw a page to indicate a wifi scan in progress."
   (draw-info-page (G_ "Scanning wifi for available networks, please wait.")
                   (G_ "Scan in progress")))
 
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 642b8c6d8a..7cc2217cbe 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,10 @@
   #:use-module ((gnu build file-systems)
                 #:select (read-partition-uuid
                           read-luks-partition-uuid))
+  #:use-module ((gnu build linux-modules)
+                #:select (missing-modules))
+  #:use-module ((gnu system linux-initrd)
+                #:select (%base-initrd-modules))
   #:use-module (guix build syscalls)
   #:use-module (guix build utils)
   #:use-module (guix records)
@@ -1243,22 +1248,51 @@ from (gnu system mapped-devices) and return it."
       (target ,label)
       (type luks-device-mapping))))
 
+(define (root-user-partition? partition)
+  "Return true if PARTITION is the root partition."
+  (let ((mount-point (user-partition-mount-point partition)))
+    (and mount-point
+         (string=? mount-point "/"))))
+
 (define (bootloader-configuration user-partitions)
   "Return the bootloader configuration field for USER-PARTITIONS."
-  (let* ((root-partition
-          (find (lambda (user-partition)
-                  (let ((mount-point
-                         (user-partition-mount-point user-partition)))
-                    (and mount-point
-                         (string=? mount-point "/"))))
-                user-partitions))
+  (let* ((root-partition (find root-user-partition?
+                               user-partitions))
          (root-partition-disk (user-partition-disk-file-name root-partition)))
     `((bootloader-configuration
        ,@(if (efi-installation?)
              `((bootloader grub-efi-bootloader)
                (target ,(default-esp-mount-point)))
              `((bootloader grub-bootloader)
-               (target ,root-partition-disk)))))))
+               (target ,root-partition-disk)))
+
+       ;; XXX: Assume we defined the 'keyboard-layout' field of
+       ;; <operating-system> right above.
+       (keyboard-layout keyboard-layout)))))
+
+(define (user-partition-missing-modules user-partitions)
+  "Return the list of kernel modules missing from the default set of kernel
+modules to access USER-PARTITIONS."
+  (let ((devices (filter user-partition-crypt-label user-partitions))
+        (root    (find root-user-partition? user-partitions)))
+    (delete-duplicates
+     (append-map (lambda (device)
+                   (catch 'system-error
+                     (lambda ()
+                       (missing-modules device %base-initrd-modules))
+                     (const '())))
+                 (delete-duplicates
+                  (map user-partition-file-name
+                       (cons root devices)))))))
+
+(define (initrd-configuration user-partitions)
+  "Return an 'initrd-modules' field with everything needed for
+USER-PARTITIONS, or return nothing."
+  (match (user-partition-missing-modules user-partitions)
+    (()
+     '())
+    ((modules ...)
+     `((initrd-modules ',modules)))))
 
 (define (user-partitions->configuration user-partitions)
   "Return the configuration field for USER-PARTITIONS."
@@ -1266,10 +1300,11 @@ from (gnu system mapped-devices) and return it."
          (swap-devices (map user-partition-file-name swap-user-partitions))
          (encrypted-partitions
           (filter user-partition-crypt-label user-partitions)))
-    `(,@(if (null? swap-devices)
+    `((bootloader ,@(bootloader-configuration user-partitions))
+      ,@(initrd-configuration user-partitions)
+      ,@(if (null? swap-devices)
             '()
             `((swap-devices (list ,@swap-devices))))
-      (bootloader ,@(bootloader-configuration user-partitions))
       ,@(if (null? encrypted-partitions)
             '()
             `((mapped-devices
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index ed44b87682..fbfcdac4e5 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,42 +19,129 @@
 
 (define-module (gnu installer services)
   #:use-module (guix records)
-  #:export (<desktop-environment>
-            desktop-environment
-            make-desktop-environment
-            desktop-environment-name
-            desktop-environment-snippet
+  #:use-module (srfi srfi-1)
+  #:export (system-service?
+            system-service-name
+            system-service-type
+            system-service-recommended?
+            system-service-snippet
+            system-service-packages
 
-            %desktop-environments
-            desktop-environments->configuration))
+            desktop-system-service?
+            networking-system-service?
 
-(define-record-type* <desktop-environment>
-  desktop-environment make-desktop-environment
-  desktop-environment?
-  (name            desktop-environment-name) ;string
-  (snippet         desktop-environment-snippet)) ;symbol
+            %system-services
+            system-services->configuration))
+
+(define-record-type* <system-service>
+  system-service make-system-service
+  system-service?
+  (name            system-service-name)           ;string
+  (type            system-service-type)           ;'desktop | 'networking
+  (recommended?    system-service-recommended?    ;Boolean
+                   (default #f))
+  (snippet         system-service-snippet         ;list of sexps
+                   (default '()))
+  (packages        system-service-packages        ;list of sexps
+                   (default '())))
 
 ;; This is the list of desktop environments supported as services.
-(define %desktop-environments
-  (list
-   (desktop-environment
-    (name "GNOME")
-    (snippet '(gnome-desktop-service)))
-   (desktop-environment
-    (name "Xfce")
-    (snippet '(xfce-desktop-service)))
-   (desktop-environment
-    (name "MATE")
-    (snippet '(mate-desktop-service)))
-   (desktop-environment
-    (name "Enlightenment")
-    (snippet '(service enlightenment-desktop-service-type)))))
-
-(define (desktop-environments->configuration desktop-environments)
-  "Return the configuration field for DESKTOP-ENVIRONMENTS."
-  (let ((snippets
-         (map desktop-environment-snippet desktop-environments)))
-    `(,@(if (null? snippets)
-            '()
-            `((services (cons* ,@snippets
-                               %desktop-services)))))))
+(define %system-services
+  (let-syntax ((desktop-environment (syntax-rules ()
+                                      ((_ fields ...)
+                                       (system-service
+                                        (type 'desktop)
+                                        fields ...))))
+               (G_ (syntax-rules ()               ;for xgettext
+                     ((_ str) str))))
+    (list
+     (desktop-environment
+      (name "GNOME")
+      (snippet '((service gnome-desktop-service-type))))
+     (desktop-environment
+      (name "Xfce")
+      (snippet '((service xfce-desktop-service-type))))
+     (desktop-environment
+      (name "MATE")
+      (snippet '((service mate-desktop-service-type))))
+     (desktop-environment
+      (name "Enlightenment")
+      (snippet '((service enlightenment-desktop-service-type))))
+     (desktop-environment
+      (name "Openbox")
+      (packages '((specification->package "openbox"))))
+     (desktop-environment
+      (name "awesome")
+      (packages '((specification->package "awesome"))))
+     (desktop-environment
+      (name "i3")
+      (packages '((specification->package "i3-wm"))))
+     (desktop-environment
+      (name "ratpoison")
+      (packages '((specification->package "ratpoison"))))
+
+     ;; Networking.
+     (system-service
+      (name (G_ "OpenSSH secure shell daemon (sshd)"))
+      (type 'networking)
+      (snippet '((service openssh-service-type))))
+     (system-service
+      (name (G_ "Tor anonymous network router"))
+      (type 'networking)
+      (snippet '((service tor-service-type))))
+     (system-service
+      (name (G_ "Mozilla NSS certificates, for HTTPS access"))
+      (type 'networking)
+      (packages '((specification->package "nss-certs")))
+      (recommended? #t))
+
+     ;; Network connectivity management.
+     (system-service
+      (name (G_ "NetworkManager network connection manager"))
+      (type 'network-management)
+      (snippet '((service network-manager-service-type)
+                 (service wpa-supplicant-service-type))))
+     (system-service
+      (name (G_ "Connman network connection manager"))
+      (type 'network-management)
+      (snippet '((service connman-service-type)
+                 (service wpa-supplicant-service-type))))
+     (system-service
+      (name (G_ "DHCP client (dynamic IP address assignment)"))
+      (type 'network-management)
+      (snippet '((service dhcp-client-service-type)))))))
+
+(define (desktop-system-service? service)
+  "Return true if SERVICE is a desktop environment service."
+  (eq? 'desktop (system-service-type service)))
+
+(define (networking-system-service? service)
+  "Return true if SERVICE is a desktop environment service."
+  (eq? 'networking (system-service-type service)))
+
+(define (system-services->configuration services)
+  "Return the configuration field for SERVICES."
+  (let* ((snippets (append-map system-service-snippet services))
+         (packages (append-map system-service-packages services))
+         (desktop? (find desktop-system-service? services))
+         (base     (if desktop?
+                       '%desktop-services
+                       '%base-services)))
+    (if (null? snippets)
+        `(,@(if (null? packages)
+                '()
+                `((packages (list ,@packages))))
+          (services ,base))
+        `(,@(if (null? packages)
+                '()
+                `((packages (list ,@packages))))
+          (services (append (list ,@snippets
+
+                                  ,@(if desktop?
+                                        ;; XXX: Assume 'keyboard-layout' is in
+                                        ;; scope.
+                                        '((set-xorg-configuration
+                                           (xorg-configuration
+                                            (keyboard-layout keyboard-layout))))
+                                        '()))
+                           ,base))))))
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 3f0bdad4f7..039dd0ca10 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -113,16 +113,24 @@ return the accumalated result so far."
 
   (define* (skip-to-step step result
                          #:key todo-steps done-steps)
-    (match (list todo-steps done-steps)
-      (((todo . rest-todo) (prev-done ... last-done))
-       (if (eq? (installer-step-id todo)
-                (installer-step-id step))
+    (match todo-steps
+      ((todo . rest-todo)
+       (let ((found? (eq? (installer-step-id todo)
+                          (installer-step-id step))))
+         (cond
+          (found?
            (run result
                 #:todo-steps todo-steps
-                #:done-steps done-steps)
-           (skip-to-step step (pop-result result)
-                         #:todo-steps (cons last-done todo-steps)
-                         #:done-steps prev-done)))))
+                #:done-steps done-steps))
+          ((and (not found?)
+                (null? done-steps))
+           (error (format #f "Step ~a not found" (installer-step-id step))))
+          (else
+           (match done-steps
+             ((prev-done ... last-done)
+              (skip-to-step step (pop-result result)
+                            #:todo-steps (cons last-done todo-steps)
+                            #:done-steps prev-done)))))))))
 
   (define* (run result #:key todo-steps done-steps)
     (match todo-steps
@@ -215,7 +223,7 @@ found in RESULTS."
                   '())))
           steps))
         (modules '((use-modules (gnu))
-                   (use-service-modules desktop))))
+                   (use-service-modules desktop networking ssh xorg))))
     `(,@modules
       ()
       (operating-system ,@configuration))))
diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm
index 1f8d40a011..4e701e64ce 100644
--- a/gnu/installer/user.scm
+++ b/gnu/installer/user.scm
@@ -18,12 +18,15 @@
 
 (define-module (gnu installer user)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #:export (<user>
             user
             make-user
             user-name
+            user-real-name
             user-group
             user-home-directory
+            user-password
 
             users->configuration))
 
@@ -31,20 +34,28 @@
   user make-user
   user?
   (name            user-name)
+  (real-name       user-real-name
+                   (default ""))
   (group           user-group
                    (default "users"))
+  (password        user-password)
   (home-directory  user-home-directory))
 
 (define (users->configuration users)
   "Return the configuration field for USERS."
+  (define (user->sexp user)
+    `(user-account
+      (name ,(user-name user))
+      (comment ,(user-real-name user))
+      (group ,(user-group user))
+      (home-directory ,(user-home-directory user))
+      (supplementary-groups '("wheel" "netdev"
+                              "audio" "video"))))
+
   `((users (cons*
-             ,@(map (lambda (user)
-                      `(user-account
-                        (name ,(user-name user))
-                        (group ,(user-group user))
-                        (home-directory ,(user-home-directory user))
-                        (supplementary-groups
-                         (quote ("wheel" "netdev"
-                                 "audio" "video")))))
-                    users)
-             %base-user-accounts))))
+            ,@(filter-map (lambda (user)
+                            ;; Do not emit a 'user-account' form for "root".
+                            (and (not (string=? (user-name user) "root"))
+                                 (user->sexp user)))
+                          users)
+            %base-user-accounts))))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index e91f90a84d..ddb96bc338 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +20,8 @@
 (define-module (gnu installer utils)
   #:use-module (guix utils)
   #:use-module (guix build utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-34)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 textual-ports)
@@ -54,10 +57,37 @@ number. If no percentage is found, return #f"
     (and result
          (string->number (match:substring result 1)))))
 
-(define (run-shell-command command)
+(define* (run-shell-command command #:key locale)
+  "Run COMMAND, a string, with Bash, and in the given LOCALE.  Return true if
+COMMAND exited successfully, #f otherwise."
+  (define (pause)
+    (format #t (G_ "Press Enter to continue.~%"))
+    (read-line (current-input-port)))
+
   (call-with-temporary-output-file
    (lambda (file port)
-     (format port "~a~%" command)
-     ;; (format port "exit~%")
+     (when locale
+       (let ((supported? (false-if-exception
+                          (setlocale LC_ALL locale))))
+         ;; If LOCALE is not supported, then set LANGUAGE, which might at
+         ;; least give us translated messages.
+         (if supported?
+             (format port "export LC_ALL=\"~a\"~%" locale)
+             (format port "export LANGUAGE=\"~a\"~%"
+                     (string-take locale
+                                  (string-index locale #\_))))))
+
+     (format port "exec ~a~%" command)
      (close port)
-     (invoke "bash" "--init-file" file))))
+
+     (guard (c ((invoke-error? c)
+                (newline)
+                (format (current-error-port)
+                        (G_ "Command failed with exit code ~a.~%")
+                        (invoke-error-exit-status c))
+                (pause)
+                #f))
+       (invoke "bash" "--init-file" file)
+       (newline)
+       (pause)
+       #t))))