gnu: zerofree: Update to 1.1.0.

* gnu/packages/linux.scm (zerofree): Update to 1.1.0. [home-page, source]: Update from old, inaccessible location.
author: Tobias Geerinckx-Rice <me@tobias.gr> 2017-08-03 22:27:21 +0200
committer: Tobias Geerinckx-Rice <me@tobias.gr> 2017-08-04 01:51:22 +0200
commit: 30ac4cc7e6a1819d4d56c02e695020498d7653d3 (patch)
tree: ca77cbfc41fbe04f0d627cd7f97ad0f5249e52bb /ChangeLog
parent: 4de4a1cfccb981757765202a0fd2db4bf7479822 (diff)
download: guix-30ac4cc7e6a1819d4d56c02e695020498d7653d3.tar.gz
guix-30ac4cc7e6a1819d4d56c02e695020498d7653d3.zip
0 files changed, 0 insertions, 0 deletions
diff --git a/TODO b/TODO
index 3a8a77b145..3c7ae6ef6c 100644
--- a/TODO
+++ b/TODO
@@ -4,6 +4,7 @@
 #+STARTUP: content hidestars
 
 Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 
   Copying and distribution of this file, with or without modification,
   are permitted in any medium without royalty provided the copyright
@@ -83,3 +84,38 @@ Problems include that current glibc releases do not build on GNU/Hurd.
 In addition, there haven’t been stable releases of GNU Mach, MiG, and
 Hurd, which would be a pre-condition.
 
+* Installer
+** Fix impossibility to restart on error after cow-store has been started
+See https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
+- Force reboot upon installer failure
+- Unshare the installer process
+- Run the installer process in a separate namespace
+** Partitioning
+*** Add RAID support
+*** Add more partitioning schemes
+The actual schemes are taken from Debian Installer but some are not
+implemented yet: like "Separate partitions for /home /var and /tmp".
+*** Replace wait page "Partition formating is in progress, please wait"
+Create a new waiting page describing what's being done:
+
+[              20%              ]
+Running mkfs.ext4 on /dev/sda2 ...
+
+[              40%              ]
+Running mkfs.ext4 on /dev/sda3 ...
+
+** Desktop environments
+*** Allow for no desktop environments
+Propose to choose between "headless server" and "lightweight X11" in a new
+page.
+*** Add services selection feature
+Add a services page to the configuration. Ask for services to be installed
+like SSH, bluetooth, TLP in a checkbox list?
+** Locale and keymap
+*** Try to guess user locale and keymap by probing BIOS or HW (dmidecode)
+** Timezone
+*** Regroup everything in one single page
+Under the form:
+(UTC + 1) Europe/Paris
+(UTC + 2) Africa/Cairo
+...
diff --git a/configure.ac b/configure.ac
index 891fce28ae..5d70de4beb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -135,6 +135,21 @@ if test "x$have_guile_gcrypt" != "xyes"; then
   AC_MSG_ERROR([Guile-Gcrypt could not be found; please install it.])
 fi
 
+dnl Guile-newt is used by the graphical installer.
+GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])
+
+AC_ARG_ENABLE([installer],
+    AS_HELP_STRING([--enable-installer], [Build the graphical installer sources.]))
+
+AS_IF([test "x$enable_installer" = "xyes"], [
+if test "x$have_guile_newt" != "xyes"; then
+  AC_MSG_ERROR([Guile-newt could not be found; please install it.])
+fi
+])
+
+AM_CONDITIONAL([ENABLE_INSTALLER],
+  [test "x$enable_installer" = "xyes"])
+
 dnl Make sure we have a full-fledged Guile.
 GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads])
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 34d0bf32fa..d6148757fe 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9328,12 +9328,20 @@ GuixSD in a virtual machine (VM).
 @subsection Preparing for Installation
 
 Once you have successfully booted your computer using the installation medium,
-you should end up with a root prompt.  Several console TTYs are configured
-and can be used to run commands as root.  TTY2 shows this documentation,
-browsable using the Info reader commands (@pxref{Top,,, info-stnd,
-Stand-alone GNU Info}).  The installation system runs the GPM mouse
-daemon, which allows you to select text with the left mouse button and
-to paste it with the middle button.
+you should end up with the welcome page of the graphical installer.  The
+graphical installer is a text-based user interface built upon the newt
+library.  It shall guide you through all the different steps needed to install
+GNU GuixSD.  However, as the graphical installer is still under heavy
+development, you might want to fallback to the original, shell based install
+process, by switching to TTYs 3 to 6 with the shortcuts CTRL-ALT-F[3-6]. The
+following sections describe the installation procedure assuming you're using
+one of those TTYs. They are configured and can be used to run commands as
+root.
+
+TTY2 shows this documentation, browsable using the Info reader commands
+(@pxref{Top,,, info-stnd, Stand-alone GNU Info}).  The installation system
+runs the GPM mouse daemon, which allows you to select text with the left mouse
+button and to paste it with the middle button.
 
 @quotation Note
 Installation requires access to the Internet so that any missing
@@ -9660,12 +9668,12 @@ unless your configuration specifies otherwise
 (@pxref{user-account-password, user account passwords}).
 
 @cindex upgrading GuixSD
-From then on, you can update GuixSD whenever you want by running
-@command{guix pull} as @code{root} (@pxref{Invoking guix pull}), and
-then running @command{guix system reconfigure} to build a new system
-generation with the latest packages and services (@pxref{Invoking guix
-system}).  We recommend doing that regularly so that your system
-includes the latest security updates (@pxref{Security Updates}).
+From then on, you can update GuixSD whenever you want by running @command{guix
+pull} as @code{root} (@pxref{Invoking guix pull}), and then running
+@command{guix system reconfigure /etc/config.scm}, as @code{root} too, to
+build a new system generation with the latest packages and services
+(@pxref{Invoking guix system}).  We recommend doing that regularly so that
+your system includes the latest security updates (@pxref{Security Updates}).
 
 Join us on @code{#guix} on the Freenode IRC network or on
 @email{guix-devel@@gnu.org} to share your experience---good or not so
@@ -10848,7 +10856,9 @@ system, you will want to append services to @var{%base-services}, like
 this:
 
 @example
-(cons* (avahi-service) (lsh-service) %base-services)
+(cons* (service avahi-service-type)
+       (service openssh-service-type)
+       %base-services)
 @end example
 @end defvr
 
@@ -12634,6 +12644,19 @@ This is a symbol specifying the logging level: @code{quiet}, @code{fatal},
 @code{error}, @code{info}, @code{verbose}, @code{debug}, etc.  See the man
 page for @file{sshd_config} for the full list of level names.
 
+@item @code{extra-content} (default: @code{""})
+This field can be used to append arbitrary text to the configuration file.  It
+is especially useful for elaborate configurations that cannot be expressed
+otherwise.  This configuration, for example, would generally disable root
+logins, but permit them from one specific IP address:
+
+@example
+(openssh-configuration
+  (extra-content "\
+Match Address 192.168.0.1
+  PermitRootLogin yes"))
+@end example
+
 @end table
 @end deftp
 
@@ -12709,31 +12732,54 @@ browsers, from accessing Facebook.
 
 The @code{(gnu services avahi)} provides the following definition.
 
-@deffn {Scheme Procedure} avahi-service [#:avahi @var{avahi}] @
-          [#:host-name #f] [#:publish? #t] [#:ipv4? #t] @
-          [#:ipv6? #t] [#:wide-area? #f] @
-          [#:domains-to-browse '()] [#:debug? #f]
-Return a service that runs @command{avahi-daemon}, a system-wide
+@defvr {Scheme Variable} avahi-service-type
+This is the service that runs @command{avahi-daemon}, a system-wide
 mDNS/DNS-SD responder that allows for service discovery and
-"zero-configuration" host name lookups (see @uref{http://avahi.org/}), and
-extends the name service cache daemon (nscd) so that it can resolve
-@code{.local} host names using
-@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}.  Additionally,
-add the @var{avahi} package to the system profile so that commands such as
-@command{avahi-browse} are directly usable.
-
-If @var{host-name} is different from @code{#f}, use that as the host name to
+``zero-configuration'' host name lookups (see @uref{http://avahi.org/}).
+Its value must be a @code{zero-configuration} record---see below.
+
+This service extends the name service cache daemon (nscd) so that it can
+resolve @code{.local} host names using
+@uref{http://0pointer.de/lennart/projects/nss-mdns/, nss-mdns}.  @xref{Name
+Service Switch}, for information on host name resolution.
+
+Additionally, add the @var{avahi} package to the system profile so that
+commands such as @command{avahi-browse} are directly usable.
+@end defvr
+
+@deftp {Data Type} avahi-configuration
+Data type representation the configuration for Avahi.
+
+@table @asis
+
+@item @code{host-name} (default: @code{#f})
+If different from @code{#f}, use that as the host name to
 publish for this machine; otherwise, use the machine's actual host name.
 
-When @var{publish?} is true, publishing of host names and services is allowed;
-in particular, avahi-daemon will publish the machine's host name and IP
-address via mDNS on the local network.
+@item @code{publish?} (default: @code{#t})
+When true, allow host names and services to be published (broadcast) over the
+network.
 
-When @var{wide-area?} is true, DNS-SD over unicast DNS is enabled.
+@item @code{publish-workstation?} (default: @code{#t})
+When true, @command{avahi-daemon} publishes the machine's host name and IP
+address via mDNS on the local network.  To view the host names published on
+your local network, you can run:
 
-Boolean values @var{ipv4?} and @var{ipv6?} determine whether to use IPv4/IPv6
-sockets.
-@end deffn
+@example
+avahi-browse _workstation._tcp
+@end example
+
+@item @code{wide-area?} (default: @code{#f})
+When true, DNS-SD over unicast DNS is enabled.
+
+@item @code{ipv4?} (default: @code{#t})
+@itemx @code{ipv6?} (default: @code{#t})
+These fields determine whether to use IPv4/IPv6 sockets.
+
+@item @code{domains-to-browse} (default: @code{'()})
+This is a list of domains to browse.
+@end table
+@end deftp
 
 @deffn {Scheme Variable} openvswitch-service-type
 This is the type of the @uref{http://www.openvswitch.org, Open vSwitch}
@@ -22339,8 +22385,8 @@ want is to have @code{.local} host lookup working.
 
 Note that, in this case, in addition to setting the
 @code{name-service-switch} of the @code{operating-system} declaration,
-you also need to use @code{avahi-service} (@pxref{Networking Services,
-@code{avahi-service}}), or @var{%desktop-services}, which includes it
+you also need to use @code{avahi-service-type} (@pxref{Networking Services,
+@code{avahi-service-type}}), or @var{%desktop-services}, which includes it
 (@pxref{Desktop Services}).  Doing this makes @code{nss-mdns} accessible
 to the name service cache daemon (@pxref{Base Services,
 @code{nscd-service}}).
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 4f2c71cb5a..a32bf5ec67 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -105,9 +105,7 @@
   bootloader-configuration make-bootloader-configuration
   bootloader-configuration?
   (bootloader                      bootloader-configuration-bootloader)    ; <bootloader>
-  (device                          bootloader-configuration-device         ; string
-                                   (default #f))
-  (target                          %bootloader-configuration-target         ; string
+  (target                          bootloader-configuration-target         ; string
                                    (default #f))
   (menu-entries                    bootloader-configuration-menu-entries   ; list of <boot-parameters>
                                    (default '()))
@@ -128,15 +126,6 @@
   (additional-configuration        bootloader-configuration-additional-configuration ; record
                                    (default #f)))
 
-(define (bootloader-configuration-target config)
-  (or (%bootloader-configuration-target config)
-      (let ((device (bootloader-configuration-device config)))
-        (when device
-          (warning
-           (G_ "The 'device' field of bootloader configurations is deprecated.~%"))
-          (warning (G_ "Use 'target' instead.~%")))
-        device)))
-
 
 ;;;
 ;;; Bootloaders.
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index e3369d8521..c468144170 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -42,6 +42,10 @@
             find-partition-by-luks-uuid
             canonicalize-device-spec
 
+            read-partition-label
+            read-partition-uuid
+            read-luks-partition-uuid
+
             bind-mount
 
             mount-flags->bit-mask
@@ -435,6 +439,12 @@ partition field reader that returned a value."
 (define read-partition-uuid
   (cut read-partition-field <> %partition-uuid-readers))
 
+(define luks-partition-field-reader
+  (partition-field-reader read-luks-header luks-header-uuid))
+
+(define read-luks-partition-uuid
+  (cut read-partition-field <> (list luks-partition-field-reader)))
+
 (define (partition-predicate reader =)
   "Return a predicate that returns true if the FIELD of partition header that
 was READ is = to the given value."
@@ -451,9 +461,7 @@ was READ is = to the given value."
   (partition-predicate read-partition-uuid uuid=?))
 
 (define luks-partition-uuid-predicate
-  (partition-predicate
-   (partition-field-reader read-luks-header luks-header-uuid)
-   uuid=?))
+  (partition-predicate luks-partition-field-reader uuid=?))
 
 (define (find-partition predicate)
   "Return the first partition found that matches PREDICATE, or #f if none
diff --git a/gnu/ci.scm b/gnu/ci.scm
index c071f21e0a..943fbb6af6 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
@@ -24,7 +24,9 @@
   #:use-module (guix grafts)
   #:use-module (guix profiles)
   #:use-module (guix packages)
+  #:use-module (guix channels)
   #:use-module (guix derivations)
+  #:use-module (guix build-system)
   #:use-module (guix monads)
   #:use-module (guix ui)
   #:use-module ((guix licenses)
@@ -188,8 +190,40 @@ system.")
                                               "iso9660"))))))
       '()))
 
-(define (system-test-jobs store system)
+(define channel-build-system
+  ;; Build system used to "convert" a channel instance to a package.
+  (let* ((build (lambda* (store name inputs
+                                #:key instance #:allow-other-keys)
+                  (run-with-store store
+                    (channel-instances->derivation (list instance)))))
+         (lower (lambda* (name #:key system instance #:allow-other-keys)
+                  (bag
+                    (name name)
+                    (system system)
+                    (build build)
+                    (arguments `(#:instance ,instance))))))
+    (build-system (name 'channel)
+                  (description "Turn a channel instance into a package.")
+                  (lower lower))))
+
+(define (channel-instance->package instance)
+  "Return a package for the given channel INSTANCE."
+  (package
+    (inherit guix)
+    (version (or (string-take (channel-instance-commit instance) 7)
+                 (string-append (package-version guix) "+")))
+    (build-system channel-build-system)
+    (arguments `(#:instance ,instance))
+    (inputs '())
+    (native-inputs '())
+    (propagated-inputs '())))
+
+(define* (system-test-jobs store system
+                           #:key source commit)
   "Return a list of jobs for the system tests."
+  (define instance
+    (checkout->channel-instance source #:commit commit))
+
   (define (test->thunk test)
     (lambda ()
       (define drv
@@ -217,7 +251,13 @@ system.")
       (cons name (test->thunk test))))
 
   (if (member system %guixsd-supported-systems)
-      (map ->job (all-system-tests))
+      ;; Override the value of 'current-guix' used by system tests.  Using a
+      ;; channel instance makes tests that rely on 'current-guix' less
+      ;; expensive.  It also makes sure we get a valid Guix package when this
+      ;; code is not running from a checkout.
+      (parameterize ((current-guix-package
+                      (channel-instance->package instance)))
+        (map ->job (all-system-tests)))
       '()))
 
 (define (tarball-jobs store system)
@@ -343,6 +383,21 @@ valid."
       ((lst ...)       lst)
       ((? string? str) (call-with-input-string str read))))
 
+  (define checkout
+    ;; Extract metadata about the 'guix' checkout.  Its key in ARGUMENTS may
+    ;; vary, so pick up the first one that's neither 'subset' nor 'systems'.
+    (any (match-lambda
+           ((key . value)
+            (and (not (memq key '(systems subset)))
+                 value)))
+         arguments))
+
+  (define commit
+    (assq-ref checkout 'revision))
+
+  (define source
+    (assq-ref checkout 'file-name))
+
   (define (cross-jobs system)
     (define (from-32-to-64? target)
       ;; Return true if SYSTEM is 32-bit and TARGET is 64-bit.  This hack
@@ -405,7 +460,9 @@ valid."
                                                 system))))
                        (append (filter-map job all)
                                (qemu-jobs store system)
-                               (system-test-jobs store system)
+                               (system-test-jobs store system
+                                                 #:source source
+                                                 #:commit commit)
                                (tarball-jobs store system)
                                (cross-jobs system))))
                     ((core)
diff --git a/gnu/installer.scm b/gnu/installer.scm
new file mode 100644
index 0000000000..2ae139b13f
--- /dev/null
+++ b/gnu/installer.scm
@@ -0,0 +1,358 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer)
+  #:use-module (guix discovery)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix utils)
+  #:use-module (guix ui)
+  #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages connman)
+  #:use-module (gnu packages cryptsetup)
+  #:use-module (gnu packages disk)
+  #:use-module (gnu packages guile)
+  #:autoload   (gnu packages gnupg) (guile-gcrypt)
+  #:use-module (gnu packages iso-codes)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages ncurses)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu packages xorg)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (installer-program))
+
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (rest #f)))
+
+(define* (build-compiled-file name locale-builder)
+  "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
+its result in the scheme file NAME. The derivation will also build a compiled
+version of this file."
+  (define set-utf8-locale
+    #~(begin
+        (setenv "LOCPATH"
+                #$(file-append glibc-utf8-locales "/lib/locale/"
+                               (version-major+minor
+                                (package-version glibc-utf8-locales))))
+        (setlocale LC_ALL "en_US.utf8")))
+
+  (define builder
+    (with-extensions (list guile-json)
+      (with-imported-modules (source-module-closure
+                              '((gnu installer locale)))
+        #~(begin
+            (use-modules (gnu installer locale))
+
+            ;; The locale files contain non-ASCII characters.
+            #$set-utf8-locale
+
+            (mkdir #$output)
+            (let ((locale-file
+                   (string-append #$output "/" #$name ".scm"))
+                  (locale-compiled-file
+                   (string-append #$output "/" #$name ".go")))
+              (call-with-output-file locale-file
+                (lambda (port)
+                  (write #$locale-builder port)))
+              (compile-file locale-file
+                            #:output-file locale-compiled-file))))))
+  (computed-file name builder))
+
+(define apply-locale
+  ;; Install the specified locale.
+  #~(lambda (locale-name)
+      (false-if-exception
+       (setlocale LC_ALL locale-name))))
+
+(define* (compute-locale-step #:key
+                              locales-name
+                              iso639-languages-name
+                              iso3166-territories-name)
+  "Return a gexp that run the locale-page of INSTALLER, and install the
+selected locale. The list of locales, languages and territories passed to
+locale-page are computed in derivations named respectively LOCALES-NAME,
+ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
+so that when the installer is run, all the lengthy operations have already
+been performed at build time."
+  (define (compiled-file-loader file name)
+    #~(load-compiled
+       (string-append #$file "/" #$name ".go")))
+
+  (let* ((supported-locales #~(supported-locales->locales
+                               #$(local-file "installer/aux-files/SUPPORTED")))
+         (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
+         (iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
+         (iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
+         (iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
+         (locales-file (build-compiled-file
+                        locales-name
+                        #~`(quote ,#$supported-locales)))
+         (iso639-file (build-compiled-file
+                       iso639-languages-name
+                       #~`(quote ,(iso639->iso639-languages
+                                   #$supported-locales
+                                   #$iso639-3 #$iso639-5))))
+         (iso3166-file (build-compiled-file
+                        iso3166-territories-name
+                        #~`(quote ,(iso3166->iso3166-territories #$iso3166))))
+         (locales-loader (compiled-file-loader locales-file
+                                               locales-name))
+         (iso639-loader (compiled-file-loader iso639-file
+                                              iso639-languages-name))
+         (iso3166-loader (compiled-file-loader iso3166-file
+                                               iso3166-territories-name)))
+    #~(lambda (current-installer)
+        (let ((result
+               ((installer-locale-page current-installer)
+                #:supported-locales #$locales-loader
+                #:iso639-languages #$iso639-loader
+                #:iso3166-territories #$iso3166-loader)))
+          (#$apply-locale result)
+          result))))
+
+(define apply-keymap
+  ;; Apply the specified keymap. Use the default keyboard model.
+  #~(match-lambda
+      ((layout variant)
+       (kmscon-update-keymap (default-keyboard-model)
+                             layout variant))))
+
+(define* (compute-keymap-step)
+  "Return a gexp that runs the keymap-page of INSTALLER and install the
+selected keymap."
+  #~(lambda (current-installer)
+      (let ((result
+             (call-with-values
+                 (lambda ()
+                   (xkb-rules->models+layouts
+                    (string-append #$xkeyboard-config
+                                   "/share/X11/xkb/rules/base.xml")))
+               (lambda (models layouts)
+                 ((installer-keymap-page current-installer)
+                  layouts)))))
+        (#$apply-keymap result))))
+
+(define (installer-steps)
+  (let ((locale-step (compute-locale-step
+                      #:locales-name "locales"
+                      #:iso639-languages-name "iso639-languages"
+                      #:iso3166-territories-name "iso3166-territories"))
+        (keymap-step (compute-keymap-step))
+        (timezone-data #~(string-append #$tzdata
+                                        "/share/zoneinfo/zone.tab")))
+    #~(lambda (current-installer)
+        (list
+         ;; Welcome the user and ask him to choose between manual
+         ;; installation and graphical install.
+         (installer-step
+          (id 'welcome)
+          (compute (lambda _
+                     ((installer-welcome-page current-installer)
+                      #$(local-file "installer/aux-files/logo.txt")))))
+
+         ;; Ask the user to choose a locale among those supported by
+         ;; the glibc.  Install the selected locale right away, so that
+         ;; the user may benefit from any available translation for the
+         ;; installer messages.
+         (installer-step
+          (id 'locale)
+          (description (G_ "Locale"))
+          (compute (lambda _
+                     (#$locale-step current-installer)))
+          (configuration-formatter locale->configuration))
+
+         ;; Ask the user to select a timezone under glibc format.
+         (installer-step
+          (id 'timezone)
+          (description (G_ "Timezone"))
+          (compute (lambda _
+                     ((installer-timezone-page current-installer)
+                      #$timezone-data)))
+          (configuration-formatter posix-tz->configuration))
+
+         ;; The installer runs in a kmscon virtual terminal where loadkeys
+         ;; won't work. kmscon uses libxkbcommon as a backend for keyboard
+         ;; input. It is possible to update kmscon current keymap by sending it
+         ;; a keyboard model, layout and variant, in a somehow similar way as
+         ;; what is done with setxkbmap utility.
+         ;;
+         ;; So ask for a keyboard model, layout and variant to update the
+         ;; current kmscon keymap.
+         (installer-step
+          (id 'keymap)
+          (description (G_ "Keyboard mapping selection"))
+          (compute (lambda _
+                     (#$keymap-step current-installer))))
+
+         ;; Run a partitioning tool allowing the user to modify
+         ;; partition tables, partitions and their mount points.
+         (installer-step
+          (id 'partition)
+          (description (G_ "Partitioning"))
+          (compute (lambda _
+                     ((installer-partition-page current-installer))))
+          (configuration-formatter user-partitions->configuration))
+
+         ;; Ask the user to input a hostname for the system.
+         (installer-step
+          (id 'hostname)
+          (description (G_ "Hostname"))
+          (compute (lambda _
+                     ((installer-hostname-page current-installer))))
+          (configuration-formatter hostname->configuration))
+
+         ;; Provide an interface above connmanctl, so that the user can select
+         ;; a network susceptible to acces Internet.
+         (installer-step
+          (id 'network)
+          (description (G_ "Network selection"))
+          (compute (lambda _
+                     ((installer-network-page current-installer)))))
+
+         ;; Prompt for users (name, group and home directory).
+         (installer-step
+          (id 'user)
+          (description (G_ "User creation"))
+          (compute (lambda _
+                     ((installer-user-page current-installer))))
+          (configuration-formatter users->configuration))
+
+         ;; Ask the user to choose one or many desktop environment(s).
+         (installer-step
+          (id 'services)
+          (description (G_ "Services"))
+          (compute (lambda _
+                     ((installer-services-page current-installer))))
+	  (configuration-formatter
+           desktop-environments->configuration))
+
+	 (installer-step
+          (id 'final)
+          (description (G_ "Configuration file"))
+          (compute
+           (lambda (result prev-steps)
+             ((installer-final-page current-installer)
+              result prev-steps))))))))
+
+(define (installer-program)
+  "Return a file-like object that runs the given INSTALLER."
+  (define init-gettext
+    ;; Initialize gettext support, so that installer messages can be
+    ;; translated.
+    #~(begin
+        (bindtextdomain "guix" (string-append #$guix "/share/locale"))
+        (textdomain "guix")))
+
+  (define set-installer-path
+    ;; Add the specified binary to PATH for later use by the installer.
+    #~(let* ((inputs
+              '#$(append (list bash ;start subshells
+                               connman ;call connmanctl
+                               cryptsetup
+                               dosfstools ;mkfs.fat
+                               e2fsprogs ;mkfs.ext4
+                               kbd ;chvt
+                               guix ;guix system init call
+                               util-linux ;mkwap
+                               shadow)
+                         (map canonical-package (list coreutils)))))
+        (with-output-to-port (%make-void-port "w")
+          (lambda ()
+            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
+
+  (define steps (installer-steps))
+  (define modules
+    (scheme-modules*
+     (string-append (current-source-directory) "/..")
+     "gnu/installer"))
+
+  (define installer-builder
+    (with-extensions (list guile-gcrypt guile-newt
+                           guile-parted guile-bytestructures
+                           guile-json)
+      (with-imported-modules `(,@(source-module-closure
+                                  `(,@modules
+                                    (guix build utils))
+                                  #:select? not-config?)
+                               ((guix config) => ,(make-config.scm)))
+        #~(begin
+            (use-modules (gnu installer record)
+                         (gnu installer keymap)
+                         (gnu installer steps)
+                         (gnu installer final)
+                         (gnu installer hostname)
+                         (gnu installer locale)
+                         (gnu installer parted)
+                         (gnu installer services)
+                         (gnu installer timezone)
+                         (gnu installer user)
+                         (gnu installer newt)
+                         (guix i18n)
+                         (guix build utils)
+                         (ice-9 match))
+
+            ;; Initialize gettext support so that installers can use
+            ;; (guix i18n) module.
+            #$init-gettext
+
+            ;; Add some binaries used by the installers to PATH.
+            #$set-installer-path
+
+            (let* ((current-installer newt-installer)
+                   (steps (#$steps current-installer)))
+              ((installer-init current-installer))
+
+              (catch #t
+                (lambda ()
+                  (run-installer-steps
+                   #:rewind-strategy 'menu
+                   #:menu-proc (installer-menu-page current-installer)
+                   #:steps steps))
+                (const #f)
+                (lambda (key . args)
+                  (let ((error-file "/tmp/last-installer-error"))
+                    (call-with-output-file error-file
+                      (lambda (port)
+                        (display-backtrace (make-stack #t) port)
+                        (print-exception port
+                                         (stack-ref (make-stack #t) 1)
+                                         key args)))
+                    ((installer-exit-error current-installer)
+                     error-file key args))
+                  (primitive-exit 1)))
+
+              ((installer-exit current-installer)))))))
+
+  (program-file
+   "installer"
+   #~(begin
+       ;; Set the default locale to install unicode support.  For
+       ;; some reason, unicode support is not correctly installed
+       ;; when calling this in 'installer-builder'.
+       (setenv "LANG" "en_US.UTF-8")
+       (system #$(program-file "installer-real" installer-builder)))))
diff --git a/gnu/installer/aux-files/SUPPORTED b/gnu/installer/aux-files/SUPPORTED
new file mode 100644
index 0000000000..24aae1e089
--- /dev/null
+++ b/gnu/installer/aux-files/SUPPORTED
@@ -0,0 +1,484 @@
+aa_DJ.UTF-8 UTF-8
+aa_DJ ISO-8859-1
+aa_ER UTF-8
+aa_ER@saaho UTF-8
+aa_ET UTF-8
+af_ZA.UTF-8 UTF-8
+af_ZA ISO-8859-1
+agr_PE UTF-8
+ak_GH UTF-8
+am_ET UTF-8
+an_ES.UTF-8 UTF-8
+an_ES ISO-8859-15
+anp_IN UTF-8
+ar_AE.UTF-8 UTF-8
+ar_AE ISO-8859-6
+ar_BH.UTF-8 UTF-8
+ar_BH ISO-8859-6
+ar_DZ.UTF-8 UTF-8
+ar_DZ ISO-8859-6
+ar_EG.UTF-8 UTF-8
+ar_EG ISO-8859-6
+ar_IN UTF-8
+ar_IQ.UTF-8 UTF-8
+ar_IQ ISO-8859-6
+ar_JO.UTF-8 UTF-8
+ar_JO ISO-8859-6
+ar_KW.UTF-8 UTF-8
+ar_KW ISO-8859-6
+ar_LB.UTF-8 UTF-8
+ar_LB ISO-8859-6
+ar_LY.UTF-8 UTF-8
+ar_LY ISO-8859-6
+ar_MA.UTF-8 UTF-8
+ar_MA ISO-8859-6
+ar_OM.UTF-8 UTF-8
+ar_OM ISO-8859-6
+ar_QA.UTF-8 UTF-8
+ar_QA ISO-8859-6
+ar_SA.UTF-8 UTF-8
+ar_SA ISO-8859-6
+ar_SD.UTF-8 UTF-8
+ar_SD ISO-8859-6
+ar_SS UTF-8
+ar_SY.UTF-8 UTF-8
+ar_SY ISO-8859-6
+ar_TN.UTF-8 UTF-8
+ar_TN ISO-8859-6
+ar_YE.UTF-8 UTF-8
+ar_YE ISO-8859-6
+ayc_PE UTF-8
+az_AZ UTF-8
+az_IR UTF-8
+as_IN UTF-8
+ast_ES.UTF-8 UTF-8
+ast_ES ISO-8859-15
+be_BY.UTF-8 UTF-8
+be_BY CP1251
+be_BY@latin UTF-8
+bem_ZM UTF-8
+ber_DZ UTF-8
+ber_MA UTF-8
+bg_BG.UTF-8 UTF-8
+bg_BG CP1251
+bhb_IN.UTF-8 UTF-8
+bho_IN UTF-8
+bho_NP UTF-8
+bi_VU UTF-8
+bn_BD UTF-8
+bn_IN UTF-8
+bo_CN UTF-8
+bo_IN UTF-8
+br_FR.UTF-8 UTF-8
+br_FR ISO-8859-1
+br_FR@euro ISO-8859-15
+brx_IN UTF-8
+bs_BA.UTF-8 UTF-8
+bs_BA ISO-8859-2
+byn_ER UTF-8
+ca_AD.UTF-8 UTF-8
+ca_AD ISO-8859-15
+ca_ES.UTF-8 UTF-8
+ca_ES ISO-8859-1
+ca_ES@euro ISO-8859-15
+ca_ES@valencia UTF-8
+ca_FR.UTF-8 UTF-8
+ca_FR ISO-8859-15
+ca_IT.UTF-8 UTF-8
+ca_IT ISO-8859-15
+ce_RU UTF-8
+chr_US UTF-8
+cmn_TW UTF-8
+crh_UA UTF-8
+cs_CZ.UTF-8 UTF-8
+cs_CZ ISO-8859-2
+csb_PL UTF-8
+cv_RU UTF-8
+cy_GB.UTF-8 UTF-8
+cy_GB ISO-8859-14
+da_DK.UTF-8 UTF-8
+da_DK ISO-8859-1
+de_AT.UTF-8 UTF-8
+de_AT ISO-8859-1
+de_AT@euro ISO-8859-15
+de_BE.UTF-8 UTF-8
+de_BE ISO-8859-1
+de_BE@euro ISO-8859-15
+de_CH.UTF-8 UTF-8
+de_CH ISO-8859-1
+de_DE.UTF-8 UTF-8
+de_DE ISO-8859-1
+de_DE@euro ISO-8859-15
+de_IT.UTF-8 UTF-8
+de_IT ISO-8859-1
+de_LI.UTF-8 UTF-8
+de_LU.UTF-8 UTF-8
+de_LU ISO-8859-1
+de_LU@euro ISO-8859-15
+doi_IN UTF-8
+dv_MV UTF-8
+dz_BT UTF-8
+el_GR.UTF-8 UTF-8
+el_GR ISO-8859-7
+el_GR@euro ISO-8859-7
+el_CY.UTF-8 UTF-8
+el_CY ISO-8859-7
+en_AG UTF-8
+en_AU.UTF-8 UTF-8
+en_AU ISO-8859-1
+en_BW.UTF-8 UTF-8
+en_BW ISO-8859-1
+en_CA.UTF-8 UTF-8
+en_CA ISO-8859-1
+en_DK.UTF-8 UTF-8
+en_DK ISO-8859-1
+en_GB.UTF-8 UTF-8
+en_GB ISO-8859-1
+en_HK.UTF-8 UTF-8
+en_HK ISO-8859-1
+en_IE.UTF-8 UTF-8
+en_IE ISO-8859-1
+en_IE@euro ISO-8859-15
+en_IL UTF-8
+en_IN UTF-8
+en_NG UTF-8
+en_NZ.UTF-8 UTF-8
+en_NZ ISO-8859-1
+en_PH.UTF-8 UTF-8
+en_PH ISO-8859-1
+en_SC.UTF-8 UTF-8
+en_SG.UTF-8 UTF-8
+en_SG ISO-8859-1
+en_US.UTF-8 UTF-8
+en_US ISO-8859-1
+en_ZA.UTF-8 UTF-8
+en_ZA ISO-8859-1
+en_ZM UTF-8
+en_ZW.UTF-8 UTF-8
+en_ZW ISO-8859-1
+eo UTF-8
+es_AR.UTF-8 UTF-8
+es_AR ISO-8859-1
+es_BO.UTF-8 UTF-8
+es_BO ISO-8859-1
+es_CL.UTF-8 UTF-8
+es_CL ISO-8859-1
+es_CO.UTF-8 UTF-8
+es_CO ISO-8859-1
+es_CR.UTF-8 UTF-8
+es_CR ISO-8859-1
+es_CU UTF-8
+es_DO.UTF-8 UTF-8
+es_DO ISO-8859-1
+es_EC.UTF-8 UTF-8
+es_EC ISO-8859-1
+es_ES.UTF-8 UTF-8
+es_ES ISO-8859-1
+es_ES@euro ISO-8859-15
+es_GT.UTF-8 UTF-8
+es_GT ISO-8859-1
+es_HN.UTF-8 UTF-8
+es_HN ISO-8859-1
+es_MX.UTF-8 UTF-8
+es_MX ISO-8859-1
+es_NI.UTF-8 UTF-8
+es_NI ISO-8859-1
+es_PA.UTF-8 UTF-8
+es_PA ISO-8859-1
+es_PE.UTF-8 UTF-8
+es_PE ISO-8859-1
+es_PR.UTF-8 UTF-8
+es_PR ISO-8859-1
+es_PY.UTF-8 UTF-8
+es_PY ISO-8859-1
+es_SV.UTF-8 UTF-8
+es_SV ISO-8859-1
+es_US.UTF-8 UTF-8
+es_US ISO-8859-1
+es_UY.UTF-8 UTF-8
+es_UY ISO-8859-1
+es_VE.UTF-8 UTF-8
+es_VE ISO-8859-1
+et_EE.UTF-8 UTF-8
+et_EE ISO-8859-1
+et_EE.ISO-8859-15 ISO-8859-15
+eu_ES.UTF-8 UTF-8
+eu_ES ISO-8859-1
+eu_ES@euro ISO-8859-15
+fa_IR UTF-8
+ff_SN UTF-8
+fi_FI.UTF-8 UTF-8
+fi_FI ISO-8859-1
+fi_FI@euro ISO-8859-15
+fil_PH UTF-8
+fo_FO.UTF-8 UTF-8
+fo_FO ISO-8859-1
+fr_BE.UTF-8 UTF-8
+fr_BE ISO-8859-1
+fr_BE@euro ISO-8859-15
+fr_CA.UTF-8 UTF-8
+fr_CA ISO-8859-1
+fr_CH.UTF-8 UTF-8
+fr_CH ISO-8859-1
+fr_FR.UTF-8 UTF-8
+fr_FR ISO-8859-1
+fr_FR@euro ISO-8859-15
+fr_LU.UTF-8 UTF-8
+fr_LU ISO-8859-1
+fr_LU@euro ISO-8859-15
+fur_IT UTF-8
+fy_NL UTF-8
+fy_DE UTF-8
+ga_IE.UTF-8 UTF-8
+ga_IE ISO-8859-1
+ga_IE@euro ISO-8859-15
+gd_GB.UTF-8 UTF-8
+gd_GB ISO-8859-15
+gez_ER UTF-8
+gez_ER@abegede UTF-8
+gez_ET UTF-8
+gez_ET@abegede UTF-8
+gl_ES.UTF-8 UTF-8
+gl_ES ISO-8859-1
+gl_ES@euro ISO-8859-15
+gu_IN UTF-8
+gv_GB.UTF-8 UTF-8
+gv_GB ISO-8859-1
+ha_NG UTF-8
+hak_TW UTF-8
+he_IL.UTF-8 UTF-8
+he_IL ISO-8859-8
+hi_IN UTF-8
+hif_FJ UTF-8
+hne_IN UTF-8
+hr_HR.UTF-8 UTF-8
+hr_HR ISO-8859-2
+hsb_DE ISO-8859-2
+hsb_DE.UTF-8 UTF-8
+ht_HT UTF-8
+hu_HU.UTF-8 UTF-8
+hu_HU ISO-8859-2
+hy_AM UTF-8
+hy_AM.ARMSCII-8 ARMSCII-8
+ia_FR UTF-8
+id_ID.UTF-8 UTF-8
+id_ID ISO-8859-1
+ig_NG UTF-8
+ik_CA UTF-8
+is_IS.UTF-8 UTF-8
+is_IS ISO-8859-1
+it_CH.UTF-8 UTF-8
+it_CH ISO-8859-1
+it_IT.UTF-8 UTF-8
+it_IT ISO-8859-1
+it_IT@euro ISO-8859-15
+iu_CA UTF-8
+ja_JP.EUC-JP EUC-JP
+ja_JP.UTF-8 UTF-8
+ka_GE.UTF-8 UTF-8
+ka_GE GEORGIAN-PS
+kab_DZ UTF-8
+kk_KZ.UTF-8 UTF-8
+kk_KZ PT154
+kl_GL.UTF-8 UTF-8
+kl_GL ISO-8859-1
+km_KH UTF-8
+kn_IN UTF-8
+ko_KR.EUC-KR EUC-KR
+ko_KR.UTF-8 UTF-8
+kok_IN UTF-8
+ks_IN UTF-8
+ks_IN@devanagari UTF-8
+ku_TR.UTF-8 UTF-8
+ku_TR ISO-8859-9
+kw_GB.UTF-8 UTF-8
+kw_GB ISO-8859-1
+ky_KG UTF-8
+lb_LU UTF-8
+lg_UG.UTF-8 UTF-8
+lg_UG ISO-8859-10
+li_BE UTF-8
+li_NL UTF-8
+lij_IT UTF-8
+ln_CD UTF-8
+lo_LA UTF-8
+lt_LT.UTF-8 UTF-8
+lt_LT ISO-8859-13
+lv_LV.UTF-8 UTF-8
+lv_LV ISO-8859-13
+lzh_TW UTF-8
+mag_IN UTF-8
+mai_IN UTF-8
+mai_NP UTF-8
+mfe_MU UTF-8
+mg_MG.UTF-8 UTF-8
+mg_MG ISO-8859-15
+mhr_RU UTF-8
+mi_NZ.UTF-8 UTF-8
+mi_NZ ISO-8859-13
+miq_NI UTF-8
+mjw_IN UTF-8
+mk_MK.UTF-8 UTF-8
+mk_MK ISO-8859-5
+ml_IN UTF-8
+mn_MN UTF-8
+mni_IN UTF-8
+mr_IN UTF-8
+ms_MY.UTF-8 UTF-8
+ms_MY ISO-8859-1
+mt_MT.UTF-8 UTF-8
+mt_MT ISO-8859-3
+my_MM UTF-8
+nan_TW UTF-8
+nan_TW@latin UTF-8
+nb_NO.UTF-8 UTF-8
+nb_NO ISO-8859-1
+nds_DE UTF-8
+nds_NL UTF-8
+ne_NP UTF-8
+nhn_MX UTF-8
+niu_NU UTF-8
+niu_NZ UTF-8
+nl_AW UTF-8
+nl_BE.UTF-8 UTF-8
+nl_BE ISO-8859-1
+nl_BE@euro ISO-8859-15
+nl_NL.UTF-8 UTF-8
+nl_NL ISO-8859-1
+nl_NL@euro ISO-8859-15
+nn_NO.UTF-8 UTF-8
+nn_NO ISO-8859-1
+nr_ZA UTF-8
+nso_ZA UTF-8
+oc_FR.UTF-8 UTF-8
+oc_FR ISO-8859-1
+om_ET UTF-8
+om_KE.UTF-8 UTF-8
+om_KE ISO-8859-1
+or_IN UTF-8
+os_RU UTF-8
+pa_IN UTF-8
+pa_PK UTF-8
+pap_AW UTF-8
+pap_CW UTF-8
+pl_PL.UTF-8 UTF-8
+pl_PL ISO-8859-2
+ps_AF UTF-8
+pt_BR.UTF-8 UTF-8
+pt_BR ISO-8859-1
+pt_PT.UTF-8 UTF-8
+pt_PT ISO-8859-1
+pt_PT@euro ISO-8859-15
+quz_PE UTF-8
+raj_IN UTF-8
+ro_RO.UTF-8 UTF-8
+ro_RO ISO-8859-2
+ru_RU.KOI8-R KOI8-R
+ru_RU.UTF-8 UTF-8
+ru_RU ISO-8859-5
+ru_UA.UTF-8 UTF-8
+ru_UA KOI8-U
+rw_RW UTF-8
+sa_IN UTF-8
+sat_IN UTF-8
+sc_IT UTF-8
+sd_IN UTF-8
+sd_IN@devanagari UTF-8
+se_NO UTF-8
+sgs_LT UTF-8
+shn_MM UTF-8
+shs_CA UTF-8
+si_LK UTF-8
+sid_ET UTF-8
+sk_SK.UTF-8 UTF-8
+sk_SK ISO-8859-2
+sl_SI.UTF-8 UTF-8
+sl_SI ISO-8859-2
+sm_WS UTF-8
+so_DJ.UTF-8 UTF-8
+so_DJ ISO-8859-1
+so_ET UTF-8
+so_KE.UTF-8 UTF-8
+so_KE ISO-8859-1
+so_SO.UTF-8 UTF-8
+so_SO ISO-8859-1
+sq_AL.UTF-8 UTF-8
+sq_AL ISO-8859-1
+sq_MK UTF-8
+sr_ME UTF-8
+sr_RS UTF-8
+sr_RS@latin UTF-8
+ss_ZA UTF-8
+st_ZA.UTF-8 UTF-8
+st_ZA ISO-8859-1
+sv_FI.UTF-8 UTF-8
+sv_FI ISO-8859-1
+sv_FI@euro ISO-8859-15
+sv_SE.UTF-8 UTF-8
+sv_SE ISO-8859-1
+sw_KE UTF-8
+sw_TZ UTF-8
+szl_PL UTF-8
+ta_IN UTF-8
+ta_LK UTF-8
+tcy_IN.UTF-8 UTF-8
+te_IN UTF-8
+tg_TJ.UTF-8 UTF-8
+tg_TJ KOI8-T
+th_TH.UTF-8 UTF-8
+th_TH TIS-620
+the_NP UTF-8
+ti_ER UTF-8
+ti_ET UTF-8
+tig_ER UTF-8
+tk_TM UTF-8
+tl_PH.UTF-8 UTF-8
+tl_PH ISO-8859-1
+tn_ZA UTF-8
+to_TO UTF-8
+tpi_PG UTF-8
+tr_CY.UTF-8 UTF-8
+tr_CY ISO-8859-9
+tr_TR.UTF-8 UTF-8
+tr_TR ISO-8859-9
+ts_ZA UTF-8
+tt_RU UTF-8
+tt_RU@iqtelif UTF-8
+ug_CN UTF-8
+uk_UA.UTF-8 UTF-8
+uk_UA KOI8-U
+unm_US UTF-8
+ur_IN UTF-8
+ur_PK UTF-8
+uz_UZ.UTF-8 UTF-8
+uz_UZ ISO-8859-1
+uz_UZ@cyrillic UTF-8
+ve_ZA UTF-8
+vi_VN UTF-8
+wa_BE ISO-8859-1
+wa_BE@euro ISO-8859-15
+wa_BE.UTF-8 UTF-8
+wae_CH UTF-8
+wal_ET UTF-8
+wo_SN UTF-8
+xh_ZA.UTF-8 UTF-8
+xh_ZA ISO-8859-1
+yi_US.UTF-8 UTF-8
+yi_US CP1255
+yo_NG UTF-8
+yue_HK UTF-8
+yuw_PG UTF-8
+zh_CN.GB18030 GB18030
+zh_CN.GBK GBK
+zh_CN.UTF-8 UTF-8
+zh_CN GB2312
+zh_HK.UTF-8 UTF-8
+zh_HK BIG5-HKSCS
+zh_SG.UTF-8 UTF-8
+zh_SG.GBK GBK
+zh_SG GB2312
+zh_TW.EUC-TW EUC-TW
+zh_TW.UTF-8 UTF-8
+zh_TW BIG5
+zu_ZA.UTF-8 UTF-8
+zu_ZA ISO-8859-1
diff --git a/gnu/installer/aux-files/logo.txt b/gnu/installer/aux-files/logo.txt
new file mode 100644
index 0000000000..52418d88c1
--- /dev/null
+++ b/gnu/installer/aux-files/logo.txt
@@ -0,0 +1,19 @@
+ ░░░                                     ░░░
+ ░░▒▒░░░░░░░░░               ░░░░░░░░░▒▒░░
+  ░░▒▒▒▒▒░░░░░░░           ░░░░░░░▒▒▒▒▒░
+      ░▒▒▒░░▒▒▒▒▒         ░░░░░░░▒▒░
+            ░▒▒▒▒░       ░░░░░░
+             ▒▒▒▒▒      ░░░░░░
+              ▒▒▒▒▒     ░░░░░
+              ░▒▒▒▒▒   ░░░░░
+               ▒▒▒▒▒   ░░░░░
+                ▒▒▒▒▒ ░░░░░
+                ░▒▒▒▒▒░░░░░
+                 ▒▒▒▒▒▒░░░
+                  ▒▒▒▒▒▒░
+  _____ _   _ _    _    _____       _
+ / ____| \ | | |  | |  / ____|     (_)
+| |  __|  \| | |  | | | |  __ _   _ ___  __
+| | |_ | . ' | |  | | | | |_ | | | | \ \/ /
+| |__| | |\  | |__| | | |__| | |_| | |>  <
+ \_____|_| \_|\____/   \_____|\__,_|_/_/\_\
diff --git a/gnu/installer/connman.scm b/gnu/installer/connman.scm
new file mode 100644
index 0000000000..740df7424a
--- /dev/null
+++ b/gnu/installer/connman.scm
@@ -0,0 +1,400 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer connman)
+  #:use-module (gnu installer utils)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (<technology>
+            technology
+            technology?
+            technology-name
+            technology-type
+            technology-powered?
+            technology-connected?
+
+            <service>
+            service
+            service?
+            service-name
+            service-type
+            service-path
+            service-strength
+            service-state
+
+            &connman-error
+            connman-error?
+            connman-error-command
+            connman-error-output
+            connman-error-status
+
+            &connman-connection-error
+            connman-connection-error?
+            connman-connection-error-service
+            connman-connection-error-output
+
+            &connman-password-error
+            connman-password-error?
+
+            &connman-already-connected-error
+            connman-already-connected-error?
+
+            connman-state
+            connman-technologies
+            connman-enable-technology
+            connman-disable-technology
+            connman-scan-technology
+            connman-services
+            connman-connect
+            connman-disconnect
+            connman-online?
+            connman-connect-with-auth))
+
+;;; Commentary:
+;;;
+;;; This module provides procedures for talking with the connman daemon.
+;;; The best approach would have been using connman dbus interface.
+;;; However, as Guile dbus bindings are not available yet, the console client
+;;; "connmanctl" is used to talk with the daemon.
+;;;
+
+
+;;;
+;;; Technology record.
+;;;
+
+;; The <technology> record encapsulates the "Technology" object of connman.
+;; Technology type will be typically "ethernet", "wifi" or "bluetooth".
+
+(define-record-type* <technology>
+  technology make-technology
+  technology?
+  (name            technology-name) ; string
+  (type            technology-type) ; string
+  (powered?        technology-powered?) ; boolean
+  (connected?      technology-connected?)) ; boolean
+
+
+;;;
+;;; Service record.
+;;;
+
+;; The <service> record encapsulates the "Service" object of connman.
+;; Service type is the same as the technology it is associated to, path is a
+;; unique identifier given by connman, strength describes the signal quality
+;; if applicable. Finally, state is "idle", "failure", "association",
+;; "configuration", "ready", "disconnect" or "online".
+
+(define-record-type* <service>
+  service make-service
+  service?
+  (name            service-name) ; string
+  (type            service-type) ; string
+  (path            service-path) ; string
+  (strength        service-strength) ; integer
+  (state           service-state)) ; string
+
+
+;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &connman-error &error
+  connman-error?
+  (command connman-error-command)
+  (output connman-error-output)
+  (status connman-error-status))
+
+(define-condition-type &connman-connection-error &error
+  connman-connection-error?
+  (service connman-connection-error-service)
+  (output  connman-connection-error-output))
+
+(define-condition-type &connman-password-error &connman-connection-error
+  connman-password-error?)
+
+(define-condition-type &connman-already-connected-error
+  &connman-connection-error connman-already-connected-error?)
+
+
+;;;
+;;; Procedures.
+;;;
+
+(define (connman-run command env arguments)
+  "Run the given COMMAND, with the specified ENV and ARGUMENTS.  The error
+output is discarded and &connman-error condition is raised if the command
+returns a non zero exit code."
+  (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null"))
+         (command-string (string-join command " "))
+         (pipe (open-input-pipe command-string))
+         (output (read-lines pipe))
+         (ret (close-pipe pipe)))
+    (case (status:exit-val ret)
+      ((0) output)
+      (else (raise (condition (&connman-error
+                               (command command)
+                               (output output)
+                               (status ret))))))))
+
+(define (connman . arguments)
+  "Run connmanctl with the specified ARGUMENTS. Set the LANG environment
+variable to C because the command output will be parsed and we don't want it
+to be translated."
+  (connman-run "connmanctl" "LANG=C" arguments))
+
+(define (parse-keys keys)
+  "Parse the given list of strings KEYS, under the following format:
+
+     '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...)
+
+Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
+...)  elements."
+  (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)")))
+    (map (lambda (key)
+           (let ((match-key (regexp-exec key-regex key)))
+             (cons (match:substring match-key 1)
+                   (match:substring match-key 2))))
+         keys)))
+
+(define (connman-state)
+  "Return the state of connman. The nominal states are 'offline, 'idle,
+'ready, 'oneline.  If an unexpected state is read, 'unknown is
+returned. Finally, an error is raised if the comman output could not be
+parsed, usually because the connman daemon is not responding."
+  (let* ((output (connman "state"))
+         (state-keys (parse-keys output)))
+    (let ((state (assoc-ref state-keys "State")))
+      (if state
+          (cond ((string=? state "offline") 'offline)
+                ((string=? state "idle") 'idle)
+                ((string=? state "ready") 'ready)
+                ((string=? state "online") 'online)
+                (else 'unknown))
+          (raise (condition
+                  (&message
+                   (message "Could not determine the state of connman."))))))))
+
+(define (split-technology-list technologies)
+  "Parse the given strings list TECHNOLOGIES, under the following format:
+
+	'((\"/net/connman/technology/xxx\")
+          (\"KEY = VALUE\")
+          ...
+          (\"/net/connman/technology/yyy\")
+          (\"KEY2 = VALUE2\")
+          ...)
+ Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...))
+list so that each keys of a given technology are gathered in a separate list."
+  (let loop ((result '())
+             (cur-list '())
+             (input (reverse technologies)))
+    (if (null? input)
+        result
+        (let ((item (car input)))
+          (if (string-match "/net/connman/technology" item)
+              (loop (cons cur-list result) '() (cdr input))
+              (loop result (cons item cur-list) (cdr input)))))))
+
+(define (string->boolean string)
+  (equal? string "True"))
+
+(define (connman-technologies)
+  "Return a list of available <technology> records."
+
+  (define (technology-output->technology output)
+    (let ((keys (parse-keys output)))
+      (technology
+       (name (assoc-ref keys "Name"))
+       (type (assoc-ref keys "Type"))
+       (powered? (string->boolean (assoc-ref keys "Powered")))
+       (connected? (string->boolean (assoc-ref keys "Connected"))))))
+
+  (let* ((output (connman "technologies"))
+         (technologies (split-technology-list output)))
+    (map technology-output->technology technologies)))
+
+(define (connman-enable-technology technology)
+  "Enable the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "enable" type)))
+
+(define (connman-disable-technology technology)
+  "Disable the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "disable" type)))
+
+(define (connman-scan-technology technology)
+  "Run a scan for the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "scan" type)))
+
+(define (connman-services)
+  "Return a list of available <services> records."
+
+  (define (service-output->service path output)
+    (let* ((service-keys
+            (match output
+              ((_ . rest) rest)))
+           (keys (parse-keys service-keys)))
+      (service
+       (name (assoc-ref keys "Name"))
+       (type (assoc-ref keys "Type"))
+       (path path)
+       (strength (and=> (assoc-ref keys "Strength") string->number))
+       (state (assoc-ref keys "State")))))
+
+  (let* ((out (connman "services"))
+         (out-filtered (delete "" out))
+         (services-path (map (lambda (service)
+                               (match (string-split service #\ )
+                                 ((_ ... path) path)))
+                             out-filtered))
+         (services-output (map (lambda (service)
+                                 (connman "services" service))
+                               services-path)))
+    (map service-output->service services-path services-output)))
+
+(define (connman-connect service)
+  "Connect to the given SERVICE."
+  (let ((path (service-path service)))
+    (connman "connect" path)))
+
+(define (connman-disconnect service)
+  "Disconnect from the given SERVICE."
+  (let ((path (service-path service)))
+    (connman "disconnect" path)))
+
+(define (connman-online?)
+  (let ((state (connman-state)))
+    (eq? state 'online)))
+
+(define (connman-connect-with-auth service password-proc)
+  "Connect to the given SERVICE with the password returned by calling
+PASSWORD-PROC. This is only possible in the interactive mode of connmanctl
+because authentication is done by communicating with an agent.
+
+As the open-pipe procedure of Guile do not allow to read from stderr, we have
+to merge stdout and stderr using bash redirection. Then error messages are
+extracted from connmanctl output using a regexp. This makes the whole
+procedure even more unreliable.
+
+Raise &connman-connection-error if an error occured during connection. Raise
+&connman-password-error if the given password is incorrect."
+
+  (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n"))
+
+  (define (match-connman-error str)
+    (let ((match-error (regexp-exec connman-error-regexp str)))
+      (and match-error (match:substring match-error 1))))
+
+  (define* (read-regexps-or-error port regexps error-handler)
+    "Read characters from port until an error is detected, or one of the given
+REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error
+string as argument. Raise an error if the eof is reached before one of the
+regexps is matched."
+    (let loop ((res ""))
+      (let ((char (read-char port)))
+        (cond
+         ((eof-object? char)
+          (raise (condition
+                  (&message
+                   (message "Unable to find expected regexp.")))))
+         ((match-connman-error res)
+          =>
+          (lambda (match)
+            (error-handler match)))
+         ((or-map (lambda (regexp)
+                    (and (regexp-exec regexp res) regexp))
+                  regexps)
+          =>
+          (lambda (match)
+            match))
+         (else
+          (loop (string-append res (string char))))))))
+
+  (define* (read-regexp-or-error port regexp error-handler)
+    "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP."
+    (read-regexps-or-error port (list regexp) error-handler))
+
+  (define (connman-error->condition path error)
+    (cond
+     ((string-match "Already connected" error)
+      (condition (&connman-already-connected-error
+                  (service path)
+                  (output error))))
+     (else
+      (condition (&connman-connection-error
+                  (service path)
+                  (output error))))))
+
+  (define (run-connection-sequence pipe)
+    "Run the connection sequence using PIPE as an opened port to an
+interactive connmanctl process."
+    (let* ((path (service-path service))
+           (error-handler (lambda (error)
+                            (raise
+                             (connman-error->condition path error)))))
+      ;; Start the agent.
+      (format pipe "agent on\n")
+      (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler)
+
+      ;; Let's try to connect to the service. If the service does not require
+      ;; a password, the connection might succeed right after this call.
+      ;; Otherwise, connmanctl will prompt us for a password.
+      (format pipe "connect ~a\n" path)
+      (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path)))
+             (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*"))
+             (regexps (list connected-regexp passphrase-regexp))
+             (result (read-regexps-or-error pipe regexps error-handler)))
+
+        ;; A password is required.
+        (when (eq? result passphrase-regexp)
+          (format pipe "~a~%" (password-proc))
+
+          ;; Now, we have to wait for the connection to succeed. If an error
+          ;; occurs, it is most likely because the password is incorrect.
+          ;; In that case, we escape from an eventual retry loop that would
+          ;; add complexity to this procedure, and raise a
+          ;; &connman-password-error condition.
+          (read-regexp-or-error pipe connected-regexp
+                                (lambda (error)
+                                  ;; Escape from retry loop.
+                                  (format pipe "no\n")
+                                  (raise
+                                   (condition (&connman-password-error
+                                               (service path)
+                                               (output error))))))))))
+
+  ;; XXX: Find a better way to read stderr, like with the "subprocess"
+  ;; procedure of racket that return input ports piped on the process stdin and
+  ;; stderr.
+  (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (run-connection-sequence pipe)
+        #t)
+      (lambda ()
+        (format pipe "quit\n")
+        (close-pipe pipe)))))
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
new file mode 100644
index 0000000000..e1c62f5ce0
--- /dev/null
+++ b/gnu/installer/final.scm
@@ -0,0 +1,36 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer final)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu services herd)
+  #:use-module (guix build utils)
+  #:export (install-system))
+
+(define (install-system)
+  "Start COW-STORE service on target directory and launch guix install command
+in a subshell."
+  (let ((install-command
+         (format #f "guix system init ~a ~a"
+                 (%installer-configuration-file)
+                 (%installer-target-dir))))
+    (mkdir-p (%installer-target-dir))
+    (start-service 'cow-store (list (%installer-target-dir)))
+    (false-if-exception (run-shell-command install-command))))
diff --git a/gnu/installer/hostname.scm b/gnu/installer/hostname.scm
new file mode 100644
index 0000000000..b8e823d0a8
--- /dev/null
+++ b/gnu/installer/hostname.scm
@@ -0,0 +1,23 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer hostname)
+  #:export (hostname->configuration))
+
+(define (hostname->configuration hostname)
+  `((host-name ,hostname)))
diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
new file mode 100644
index 0000000000..d66b376d9c
--- /dev/null
+++ b/gnu/installer/keymap.scm
@@ -0,0 +1,172 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer keymap)
+  #:use-module (guix records)
+  #:use-module (sxml match)
+  #:use-module (sxml simple)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (<x11-keymap-model>
+            x11-keymap-model
+            make-x11-keymap-model
+            x11-keymap-model?
+            x11-keymap-model-name
+            x11-keymap-model-description
+
+            <x11-keymap-layout>
+            x11-keymap-layout
+            make-x11-keymap-layout
+            x11-keymap-layout?
+            x11-keymap-layout-name
+            x11-keymap-layout-description
+            x11-keymap-layout-variants
+
+            <x11-keymap-variant>
+            x11-keymap-variant
+            make-x11-keymap-variant
+            x11-keymap-variant?
+            x11-keymap-variant-name
+            x11-keymap-variant-description
+
+            default-keyboard-model
+            xkb-rules->models+layouts
+            kmscon-update-keymap))
+
+(define-record-type* <x11-keymap-model>
+  x11-keymap-model make-x11-keymap-model
+  x11-keymap-model?
+  (name            x11-keymap-model-name) ;string
+  (description     x11-keymap-model-description)) ;string
+
+(define-record-type* <x11-keymap-layout>
+  x11-keymap-layout make-x11-keymap-layout
+  x11-keymap-layout?
+  (name            x11-keymap-layout-name) ;string
+  (description     x11-keymap-layout-description) ;string
+  (variants        x11-keymap-layout-variants)) ;list of <x11-keymap-variant>
+
+(define-record-type* <x11-keymap-variant>
+  x11-keymap-variant make-x11-keymap-variant
+  x11-keymap-variant?
+  (name            x11-keymap-variant-name) ;string
+  (description     x11-keymap-variant-description)) ;string
+
+;; Assume all modern keyboards have this model.
+(define default-keyboard-model (make-parameter "pc105"))
+
+(define (xkb-rules->models+layouts file)
+  "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL
+and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard
+Configuration Database, describing possible XKB configurations."
+  (define (model m)
+    (sxml-match m
+                [(model
+                  (configItem
+                   (name ,name)
+                   (description ,description)
+                   . ,rest))
+                 (x11-keymap-model
+                  (name name)
+                  (description description))]))
+
+  (define (variant v)
+    (sxml-match v
+                [(variant
+                  ;; According to xbd-rules DTD, the definition of a
+                  ;; configItem is: <!ELEMENT configItem
+                  ;; (name,shortDescription*,description*,vendor?,
+                  ;; countryList?,languageList?,hwList?)>
+                  ;;
+                  ;; shortDescription and description are optional elements
+                  ;; but sxml-match does not support default values for
+                  ;; elements (only attributes). So to avoid writing as many
+                  ;; patterns as existing possibilities, gather all the
+                  ;; remaining elements but name in REST-VARIANT.
+                  (configItem
+                   (name ,name)
+                   . ,rest-variant))
+                 (x11-keymap-variant
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-variant 'description))))]))
+
+  (define (layout l)
+    (sxml-match l
+                [(layout
+                  (configItem
+                   (name ,name)
+                   . ,rest-layout)
+                  (variantList ,[variant -> v] ...))
+                 (x11-keymap-layout
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-layout 'description)))
+                  (variants (list v ...)))]
+                [(layout
+                  (configItem
+                   (name ,name)
+                   . ,rest-layout))
+                 (x11-keymap-layout
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-layout 'description)))
+                  (variants '()))]))
+
+  (let ((sxml (call-with-input-file file
+                (lambda (port)
+                  (xml->sxml port #:trim-whitespace? #t)))))
+    (match
+        (sxml-match sxml
+                    [(*TOP*
+                      ,pi
+                      (xkbConfigRegistry
+                       (@ . ,ignored)
+                       (modelList ,[model -> m] ...)
+                       (layoutList ,[layout -> l] ...)
+                       . ,rest))
+                     (list
+                      (list m ...)
+                      (list l ...))])
+      ((models layouts)
+       (values models layouts)))))
+
+(define (kmscon-update-keymap model layout variant)
+  "Update kmscon keymap with the provided MODEL, LAYOUT and VARIANT."
+  (and=>
+   (getenv "KEYMAP_UPDATE")
+   (lambda (keymap-file)
+     (unless (file-exists? keymap-file)
+       (error "Unable to locate keymap update file"))
+
+     ;; See file gnu/packages/patches/kmscon-runtime-keymap-switch.patch.
+     ;; This dirty hack makes possible to update kmscon keymap at runtime by
+     ;; writing an X11 keyboard model, layout and variant to a named pipe
+     ;; referred by KEYMAP_UPDATE environment variable.
+     (call-with-output-file keymap-file
+       (lambda (port)
+         (format port model)
+         (put-u8 port 0)
+
+         (format port layout)
+         (put-u8 port 0)
+
+         (format port variant)
+         (put-u8 port 0))))))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
new file mode 100644
index 0000000000..2b45b2200a
--- /dev/null
+++ b/gnu/installer/locale.scm
@@ -0,0 +1,210 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer locale)
+  #:use-module (gnu installer utils)
+  #:use-module (guix records)
+  #:use-module (json)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (locale-language
+            locale-territory
+            locale-codeset
+            locale-modifier
+
+            locale->locale-string
+            supported-locales->locales
+
+            iso639->iso639-languages
+            language-code->language-name
+
+            iso3166->iso3166-territories
+            territory-code->territory-name
+
+            locale->configuration))
+
+
+;;;
+;;; Locale.
+;;;
+
+;; A glibc locale string has the following format:
+;; language[_territory[.codeset][@modifier]].
+(define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$")
+
+;; LOCALE will be better expressed in a (guix record) that in an association
+;; list. However, loading large files containing records does not scale
+;; well. The same thing goes for ISO639 and ISO3166 association lists used
+;; later in this module.
+(define (locale-language assoc)
+  (assoc-ref assoc 'language))
+(define (locale-territory assoc)
+  (assoc-ref assoc 'territory))
+(define (locale-codeset assoc)
+  (assoc-ref assoc 'codeset))
+(define (locale-modifier assoc)
+  (assoc-ref assoc 'modifier))
+
+(define (locale-string->locale string)
+  "Return the locale association list built from the parsing of STRING."
+  (let ((matches (string-match locale-regexp string)))
+    `((language  . ,(match:substring matches 1))
+      (territory . ,(match:substring matches 3))
+      (codeset   . ,(match:substring matches 5))
+      (modifier  . ,(match:substring matches 7)))))
+
+(define (locale->locale-string locale)
+  "Reverse operation of locale-string->locale."
+  (let ((language (locale-language locale))
+        (territory (locale-territory locale))
+        (codeset (locale-codeset locale))
+        (modifier (locale-modifier locale)))
+    (apply string-append
+           `(,language
+             ,@(if territory
+                   `("_" ,territory)
+                   '())
+             ,@(if codeset
+                   `("." ,codeset)
+                   '())
+             ,@(if modifier
+                   `("@" ,modifier)
+                   '())))))
+
+(define (supported-locales->locales supported-locales)
+  "Parse the SUPPORTED-LOCALES file from the glibc and return the matching
+list of LOCALE association lists."
+ (call-with-input-file supported-locales
+    (lambda (port)
+      (let ((lines (read-lines port)))
+        (map (lambda (line)
+               (match (string-split line #\ )
+                 ((locale-string codeset)
+                  (let ((line-locale (locale-string->locale locale-string)))
+                    (assoc-set! line-locale 'codeset codeset)))))
+             lines)))))
+
+
+;;;
+;;; Language.
+;;;
+
+(define (iso639-language-alpha2 assoc)
+  (assoc-ref assoc 'alpha2))
+
+(define (iso639-language-alpha3 assoc)
+  (assoc-ref assoc 'alpha3))
+
+(define (iso639-language-name assoc)
+  (assoc-ref assoc 'name))
+
+(define (supported-locale? locales alpha2 alpha3)
+  "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field
+matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus,
+if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was
+found."
+  (find (lambda (locale)
+          (let ((language (locale-language locale)))
+            (or (and=> alpha2
+                       (lambda (code)
+                         (string=? language code)))
+                (string=? language alpha3))))
+        locales))
+
+(define (iso639->iso639-languages locales iso639-3 iso639-5)
+  "Return a list of ISO639 association lists created from the parsing of
+ISO639-3 and ISO639-5 files."
+  (call-with-input-file iso639-3
+    (lambda (port-iso639-3)
+      (call-with-input-file iso639-5
+        (lambda (port-iso639-5)
+          (filter-map
+           (lambda (hash)
+             (let ((alpha2 (hash-ref hash "alpha_2"))
+                   (alpha3 (hash-ref hash "alpha_3"))
+                   (name   (hash-ref hash "name")))
+               (and (supported-locale? locales alpha2 alpha3)
+                    `((alpha2 . ,alpha2)
+                      (alpha3 . ,alpha3)
+                      (name   . ,name)))))
+           (append
+            (hash-ref (json->scm port-iso639-3) "639-3")
+            (hash-ref (json->scm port-iso639-5) "639-5"))))))))
+
+(define (language-code->language-name languages language-code)
+  "Using LANGUAGES as a list of ISO639 association lists, return the language
+name corresponding to the given LANGUAGE-CODE."
+  (let ((iso639-language
+         (find (lambda (language)
+                 (or
+                  (and=> (iso639-language-alpha2 language)
+                         (lambda (alpha2)
+                           (string=? alpha2 language-code)))
+                  (string=? (iso639-language-alpha3 language)
+                            language-code)))
+               languages)))
+    (iso639-language-name iso639-language)))
+
+
+;;;
+;;; Territory.
+;;;
+
+(define (iso3166-territory-alpha2 assoc)
+  (assoc-ref assoc 'alpha2))
+
+(define (iso3166-territory-alpha3 assoc)
+  (assoc-ref assoc 'alpha3))
+
+(define (iso3166-territory-name assoc)
+  (assoc-ref assoc 'name))
+
+(define (iso3166->iso3166-territories iso3166)
+  "Return a list of ISO3166 association lists created from the parsing of
+ISO3166 file."
+  (call-with-input-file iso3166
+    (lambda (port)
+      (map (lambda (hash)
+             `((alpha2 . ,(hash-ref hash "alpha_2"))
+               (alpha3 . ,(hash-ref hash "alpha_3"))
+               (name   . ,(hash-ref hash "name"))))
+           (hash-ref (json->scm port) "3166-1")))))
+
+(define (territory-code->territory-name territories territory-code)
+  "Using TERRITORIES as a list of ISO3166 association lists return the
+territory name corresponding to the given TERRITORY-CODE."
+  (let ((iso3166-territory
+         (find (lambda (territory)
+                 (or
+                  (and=> (iso3166-territory-alpha2 territory)
+                         (lambda (alpha2)
+                           (string=? alpha2 territory-code)))
+                  (string=? (iso3166-territory-alpha3 territory)
+                            territory-code)))
+               territories)))
+    (iso3166-territory-name iso3166-territory)))
+
+
+;;;
+;;; Configuration formatter.
+;;;
+
+(define (locale->configuration locale)
+  "Return the configuration field for LOCALE."
+  `((locale ,locale)))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
new file mode 100644
index 0000000000..6c44b4acf6
--- /dev/null
+++ b/gnu/installer/newt.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt)
+  #:use-module (gnu installer record)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt ethernet)
+  #:use-module (gnu installer newt final)
+  #:use-module (gnu installer newt hostname)
+  #:use-module (gnu installer newt keymap)
+  #:use-module (gnu installer newt locale)
+  #:use-module (gnu installer newt menu)
+  #:use-module (gnu installer newt network)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt partition)
+  #:use-module (gnu installer newt services)
+  #:use-module (gnu installer newt timezone)
+  #:use-module (gnu installer newt user)
+  #:use-module (gnu installer newt utils)
+  #:use-module (gnu installer newt welcome)
+  #:use-module (gnu installer newt wifi)
+  #:use-module (guix config)
+  #:use-module (guix discovery)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-26)
+  #:use-module (newt)
+  #:export (newt-installer))
+
+(define (init)
+  (newt-init)
+  (clear-screen)
+  (set-screen-size!))
+
+(define (exit)
+  (newt-finish)
+  (clear-screen))
+
+(define (exit-error file key args)
+  (newt-set-color COLORSET-ROOT "white" "red")
+  (let ((width (nearest-exact-integer
+                (* (screen-columns) 0.8)))
+        (height (nearest-exact-integer
+                 (* (screen-rows) 0.7))))
+    (run-file-textbox-page
+     #:info-text (format #f (G_ "The installer has encountered an unexpected \
+problem. The backtrace is displayed below. Please report it by email to \
+<~a>.") %guix-bug-report-address)
+     #:title (G_ "Unexpected problem")
+     #:file file
+     #:exit-button? #f
+     #:info-textbox-width width
+     #:file-textbox-width width
+     #:file-textbox-height height))
+  (newt-set-color COLORSET-ROOT "white" "blue")
+  (newt-finish)
+  (clear-screen))
+
+(define (final-page result prev-steps)
+  (run-final-page result prev-steps))
+
+(define* (locale-page #:key
+                      supported-locales
+                      iso639-languages
+                      iso3166-territories)
+  (run-locale-page
+   #:supported-locales supported-locales
+   #:iso639-languages iso639-languages
+   #:iso3166-territories iso3166-territories))
+
+(define (timezone-page zonetab)
+  (run-timezone-page zonetab))
+
+(define (welcome-page logo)
+  (run-welcome-page logo))
+
+(define (menu-page steps)
+  (run-menu-page steps))
+
+(define* (keymap-page layouts)
+  (run-keymap-page layouts))
+
+(define (network-page)
+  (run-network-page))
+
+(define (hostname-page)
+  (run-hostname-page))
+
+(define (user-page)
+  (run-user-page))
+
+(define (partition-page)
+  (run-partioning-page))
+
+(define (services-page)
+  (run-services-page))
+
+(define newt-installer
+  (installer
+   (name 'newt)
+   (init init)
+   (exit exit)
+   (exit-error exit-error)
+   (final-page final-page)
+   (keymap-page keymap-page)
+   (locale-page locale-page)
+   (menu-page menu-page)
+   (network-page network-page)
+   (timezone-page timezone-page)
+   (hostname-page hostname-page)
+   (user-page user-page)
+   (partition-page partition-page)
+   (services-page services-page)
+   (welcome-page welcome-page)))
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
new file mode 100644
index 0000000000..d1f357243b
--- /dev/null
+++ b/gnu/installer/newt/ethernet.scm
@@ -0,0 +1,81 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt ethernet)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-ethernet-page))
+
+(define (ethernet-services)
+  "Return all the connman services of ethernet type."
+  (let ((services (connman-services)))
+    (filter (lambda (service)
+              (and (string=? (service-type service) "ethernet")
+                   (not (string-null? (service-name service)))))
+            services)))
+
+(define (ethernet-service->text service)
+  "Return a string describing the given ethernet SERVICE."
+  (let* ((name (service-name service))
+         (path (service-path service))
+         (full-name (string-append name "-" path))
+         (state (service-state service))
+         (connected? (or (string=? state "online")
+                         (string=? state "ready"))))
+    (format #f "~c ~a~%"
+            (if connected? #\* #\ )
+            full-name)))
+
+(define (connect-ethernet-service service)
+  "Connect to the given ethernet SERVICE. Display a connecting page while the
+connection is pending."
+  (let* ((service-name (service-name service))
+         (form (draw-connecting-page service-name)))
+    (connman-connect service)
+    (destroy-form-and-pop form)
+    service))
+
+(define (run-ethernet-page)
+  (let ((services (ethernet-services)))
+    (if (null? services)
+        (begin
+          (run-error-page
+           (G_ "No ethernet service available, please try again.")
+           (G_ "No service"))
+          (raise
+           (condition
+            (&installer-step-abort))))
+        (run-listbox-selection-page
+         #:info-text (G_ "Please select an ethernet network.")
+         #:title (G_ "Ethernet connection")
+         #:listbox-items services
+         #:listbox-item->text ethernet-service->text
+         #:button-text (G_ "Exit")
+         #:button-callback-procedure
+         (lambda _
+           (raise
+            (condition
+             (&installer-step-abort))))
+         #:listbox-callback-procedure connect-ethernet-service))))
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
new file mode 100644
index 0000000000..645c1e8689
--- /dev/null
+++ b/gnu/installer/newt/final.scm
@@ -0,0 +1,86 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt final)
+  #:use-module (gnu installer final)
+  #:use-module (gnu installer parted)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-final-page))
+
+(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! \
+A system configuration file has been generated, it is displayed below.  \
+The new system will be created from this file once you've pressed OK.  \
+This will take a few minutes.")
+     #:title (G_ "Configuration file")
+     #:file (%installer-configuration-file)
+     #:info-textbox-width width
+     #:file-textbox-width width
+     #:file-textbox-height height
+     #:exit-button-callback-procedure
+     (lambda ()
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-install-success-page)
+  (message-window
+   (G_ "Installation complete")
+   (G_ "Reboot")
+   (G_ "Congratulations!  Installation is now complete.  \
+You may remove the device containing the installation image and \
+press the button to reboot.")))
+
+(define (run-install-failed-page)
+  (choice-window
+   (G_ "Installation failed")
+   (G_ "Restart installer")
+   (G_ "Retry system install")
+   (G_ "The final system installation step failed.  You can retry the \
+last step, or restart the installer.")))
+
+(define (run-install-shell)
+  (clear-screen)
+  (newt-suspend)
+  (let ((install-ok? (install-system)))
+    (newt-resume)
+    install-ok?))
+
+(define (run-final-page result prev-steps)
+  (let* ((configuration (format-configuration prev-steps result))
+         (user-partitions (result-step result 'partition))
+         (install-ok?
+          (with-mounted-partitions
+           user-partitions
+           (configuration->file configuration)
+           (run-config-display-page)
+           (run-install-shell))))
+    (if install-ok?
+        (run-install-success-page)
+        (run-install-failed-page))))
diff --git a/gnu/installer/newt/hostname.scm b/gnu/installer/newt/hostname.scm
new file mode 100644
index 0000000000..7783fa6360
--- /dev/null
+++ b/gnu/installer/newt/hostname.scm
@@ -0,0 +1,26 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt hostname)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:export (run-hostname-page))
+
+(define (run-hostname-page)
+  (run-input-page (G_ "Please enter the system hostname.")
+                  (G_ "Hostname")))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
new file mode 100644
index 0000000000..6211af2bc5
--- /dev/null
+++ b/gnu/installer/newt/keymap.scm
@@ -0,0 +1,122 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt keymap)
+  #:use-module (gnu installer keymap)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (newt)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (run-keymap-page))
+
+(define (run-layout-page layouts layout->text)
+  (let ((title (G_ "Layout")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Please choose your keyboard layout.")
+     #:listbox-items layouts
+     #:listbox-item->text layout->text
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Exit")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-variant-page variants variant->text)
+  (let ((title (G_ "Variant")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Please choose a variant for your keyboard layout.")
+     #:listbox-items variants
+     #:listbox-item->text variant->text
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (sort-layouts layouts)
+  "Sort LAYOUTS list by putting the US layout ahead and return it."
+  (call-with-values
+      (lambda ()
+        (partition
+         (lambda (layout)
+           (let ((name (x11-keymap-layout-name layout)))
+             (string=? name "us")))
+         layouts))
+    (cut append <> <>)))
+
+(define (sort-variants variants)
+  "Sort VARIANTS list by putting the internation variant ahead and return it."
+  (call-with-values
+      (lambda ()
+        (partition
+         (lambda (variant)
+           (let ((name (x11-keymap-variant-name variant)))
+             (string=? name "altgr-intl")))
+         variants))
+    (cut append <> <>)))
+
+(define* (run-keymap-page layouts)
+  "Run a page asking the user to select a keyboard layout and variant. LAYOUTS
+is a list of supported X11-KEYMAP-LAYOUT. Return a list of two elements, the
+names of the selected keyboard layout and variant."
+  (define keymap-steps
+    (list
+     (installer-step
+      (id 'layout)
+      (compute
+       (lambda _
+         (run-layout-page
+          (sort-layouts layouts)
+          (lambda (layout)
+            (x11-keymap-layout-description layout))))))
+     ;; Propose the user to select a variant among those supported by the
+     ;; previously selected layout.
+     (installer-step
+      (id 'variant)
+      (compute
+       (lambda (result _)
+         (let* ((layout (result-step result 'layout))
+                (variants (x11-keymap-layout-variants layout)))
+           ;; Return #f if the layout does not have any variant.
+           (and (not (null? variants))
+                (run-variant-page
+                 (sort-variants variants)
+                 (lambda (variant)
+                   (x11-keymap-variant-description
+                    variant))))))))))
+
+  (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)))))
+      (list layout (or variant ""))))
+  (format-result
+   (run-installer-steps #:steps keymap-steps)))
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
new file mode 100644
index 0000000000..4fa07df81e
--- /dev/null
+++ b/gnu/installer/newt/locale.scm
@@ -0,0 +1,217 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt locale)
+  #:use-module (gnu installer locale)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:export (run-locale-page))
+
+(define (run-language-page languages language->text)
+  (let ((title (G_ "Locale language")))
+    (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.")
+     #:info-textbox-width 70
+     #:listbox-items languages
+     #:listbox-item->text language->text
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Exit")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(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.")
+     #:listbox-items territories
+     #:listbox-item->text territory->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-codeset-page codesets)
+  (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.")
+     #:listbox-items codesets
+     #:listbox-item->text identity
+     #:listbox-default-item "UTF-8"
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-modifier-page modifiers modifier->text)
+  (let ((title (G_ "Locale modifier")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your locale's modifier. The most frequent \
+modifier is euro. It indicates that you want to use Euro as the currency \
+symbol.")
+     #:listbox-items modifiers
+     #:listbox-item->text modifier->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define* (run-locale-page #:key
+                          supported-locales
+                          iso639-languages
+                          iso3166-territories)
+  "Run a page asking the user to select a locale language and possibly
+territory, codeset and modifier. Use SUPPORTED-LOCALES as the list of glibc
+available locales. ISO639-LANGUAGES is an association list associating a
+locale code to a locale name. ISO3166-TERRITORIES is an association list
+associating a territory code with a territory name. The formated locale, under
+glibc format is returned."
+
+  (define (break-on-locale-found locales)
+    "Raise the &installer-step-break condition if LOCALES contains exactly one
+element."
+    (and (= (length locales) 1)
+         (raise
+          (condition (&installer-step-break)))))
+
+  (define (filter-locales locales result)
+    "Filter the list of locale records LOCALES using the RESULT returned by
+the installer-steps defined below."
+    (filter
+     (lambda (locale)
+       (and-map identity
+                `(,(string=? (locale-language locale)
+                             (result-step result 'language))
+                  ,@(if (result-step-done? result 'territory)
+                        (list (equal? (locale-territory locale)
+                                      (result-step result 'territory)))
+                        '())
+                  ,@(if (result-step-done? result 'codeset)
+                        (list (equal? (locale-codeset locale)
+                                      (result-step result 'codeset)))
+                        '())
+                  ,@(if (result-step-done? result 'modifier)
+                        (list (equal? (locale-modifier locale)
+                                      (result-step result 'modifier)))
+                        '()))))
+     locales))
+
+  (define (result->locale-string locales result)
+    "Supposing that LOCALES contains exactly one locale record, turn it into a
+glibc locale string and return it."
+    (match (filter-locales locales result)
+      ((locale)
+       (locale->locale-string locale))))
+
+  (define (sort-languages languages)
+    "Extract some languages from LANGUAGES list and place them ahead."
+    (let* ((first-languages '("en"))
+           (other-languages (lset-difference equal?
+                                             languages
+                                             first-languages)))
+      `(,@first-languages ,@other-languages)))
+
+  (define locale-steps
+    (list
+     (installer-step
+      (id 'language)
+      (compute
+       (lambda _
+         (run-language-page
+          (sort-languages
+           (delete-duplicates (map locale-language supported-locales)))
+          (cut language-code->language-name iso639-languages <>)))))
+     (installer-step
+      (id 'territory)
+      (compute
+       (lambda (result _)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Stop the process if the language returned by the previous step
+           ;; is matching one and only one supported locale.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask the user to select a territory among those
+           ;; 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)
+                  (G_ "No location"))))))))
+     (installer-step
+      (id 'codeset)
+      (compute
+       (lambda (result _)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same as above but we now have a language and a territory to
+           ;; 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)))))))
+     (installer-step
+      (id 'modifier)
+      (compute
+       (lambda (result _)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same thing with a language, a territory and a codeset this time.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask for a modifier.
+           (run-modifier-page
+            (delete-duplicates (map locale-modifier locales))
+            (lambda (modifier)
+              (or modifier (G_ "No modifier"))))))))))
+
+  ;; If run-installer-steps returns locally, it means that the user had to go
+  ;; through all steps (language, territory, codeset and modifier) to select a
+  ;; locale. In that case, like if we exited by raising &installer-step-break
+  ;; condition, turn the result into a glibc locale string and return it.
+  (result->locale-string
+   supported-locales
+   (run-installer-steps #:steps locale-steps)))
diff --git a/gnu/installer/newt/menu.scm b/gnu/installer/newt/menu.scm
new file mode 100644
index 0000000000..161266a94a
--- /dev/null
+++ b/gnu/installer/newt/menu.scm
@@ -0,0 +1,44 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt menu)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:export (run-menu-page))
+
+(define (run-menu-page steps)
+  "Run a menu page, asking the user to select where to resume the install
+process from."
+  (define (steps->items steps)
+    (filter (lambda (step)
+              (installer-step-description step))
+            steps))
+
+  (run-listbox-selection-page
+   #:info-text (G_ "Choose where you want to resume the install.\
+You can also abort the installation by pressing the Abort button.")
+   #:title (G_ "Installation menu")
+   #:listbox-items (steps->items steps)
+   #:listbox-item->text installer-step-description
+   #:sort-listbox-items? #f
+   #:button-text (G_ "Abort")
+   #:button-callback-procedure (lambda ()
+                                 (newt-finish)
+                                 (primitive-exit 1))))
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
new file mode 100644
index 0000000000..f263b7df9d
--- /dev/null
+++ b/gnu/installer/newt/network.scm
@@ -0,0 +1,173 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt network)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt ethernet)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt wifi)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-network-page))
+
+;; Maximum length of a technology name.
+(define technology-name-max-length (make-parameter 20))
+
+(define (technology->text technology)
+  "Return a string describing the given TECHNOLOGY."
+  (let* ((name (technology-name technology))
+         (padded-name (string-pad-right name
+                                        (technology-name-max-length))))
+    (format #f "~a~%" padded-name)))
+
+(define (run-technology-page)
+  "Run a page to ask the user which technology shall be used to access
+Internet and return the selected technology. For now, only technologies with
+\"ethernet\" or \"wifi\" types are supported."
+  (define (technology-items)
+    (filter (lambda (technology)
+              (let ((type (technology-type technology)))
+                (or
+                 (string=? type "ethernet")
+                 (string=? type "wifi"))))
+            (connman-technologies)))
+
+  (let ((items (technology-items)))
+    (if (null? items)
+        (case (choice-window
+               (G_ "Internet access")
+               (G_ "Continue")
+               (G_ "Exit")
+               (G_ "The install process requires an internet access, but no \
+network device were found. Do you want to continue anyway?"))
+          ((1) (raise
+                (condition
+                 (&installer-step-break))))
+          ((2) (raise
+                (condition
+                 (&installer-step-abort)))))
+        (run-listbox-selection-page
+         #:info-text (G_ "The install process requires an internet access.\
+ Please select a network device.")
+         #:title (G_ "Internet access")
+         #:listbox-items items
+         #:listbox-item->text technology->text
+         #:button-text (G_ "Exit")
+         #:button-callback-procedure
+         (lambda _
+           (raise
+            (condition
+             (&installer-step-abort))))))))
+
+(define (find-technology-by-type technologies type)
+  "Find and return a technology with the given TYPE in TECHNOLOGIES list."
+  (find (lambda (technology)
+          (string=? (technology-type technology)
+                    type))
+        technologies))
+
+(define (wait-technology-powered technology)
+  "Wait and display a progress bar until the given TECHNOLOGY is powered."
+  (let ((name (technology-name technology))
+        (full-value 5))
+    (run-scale-page
+     #:title (G_ "Powering technology")
+     #:info-text (format #f "Waiting for technology ~a to be powered." name)
+     #:scale-full-value full-value
+     #:scale-update-proc
+     (lambda (value)
+       (let* ((technologies (connman-technologies))
+              (type (technology-type technology))
+              (updated-technology
+               (find-technology-by-type technologies type))
+              (technology-powered? updated-technology))
+         (sleep 1)
+         (if technology-powered?
+             full-value
+             (+ value 1)))))))
+
+(define (wait-service-online)
+  "Display a newt scale until connman detects an Internet access. Do
+FULL-VALUE tentatives, spaced by 1 second."
+  (let* ((full-value 5))
+    (run-scale-page
+     #:title (G_ "Checking connectivity")
+     #:info-text (G_ "Waiting internet access is established.")
+     #:scale-full-value full-value
+     #:scale-update-proc
+     (lambda (value)
+       (sleep 1)
+       (if (connman-online?)
+           full-value
+           (+ value 1))))
+    (unless (connman-online?)
+      (run-error-page
+       (G_ "The selected network does not provide an Internet \
+access, please try again.")
+       (G_ "Connection error"))
+      (raise
+       (condition
+        (&installer-step-abort))))))
+
+(define (run-network-page)
+  "Run a page to allow the user to configure connman so that it can access the
+Internet."
+  (define network-steps
+    (list
+     ;; Ask the user to choose between ethernet and wifi technologies.
+     (installer-step
+      (id 'select-technology)
+      (compute
+       (lambda _
+         (run-technology-page))))
+     ;; Enable the previously selected technology.
+     (installer-step
+      (id 'power-technology)
+      (compute
+       (lambda (result _)
+         (let ((technology (result-step result 'select-technology)))
+           (connman-enable-technology technology)
+           (wait-technology-powered technology)))))
+     ;; Propose the user to connect to one of the service available for the
+     ;; previously selected technology.
+     (installer-step
+      (id 'connect-service)
+      (compute
+       (lambda (result _)
+         (let* ((technology (result-step result 'select-technology))
+                (type (technology-type technology)))
+           (cond
+            ((string=? "wifi" type)
+             (run-wifi-page))
+            ((string=? "ethernet" type)
+             (run-ethernet-page)))))))
+     ;; Wait for connman status to switch to 'online, which means it can
+     ;; access Internet.
+     (installer-step
+      (id 'wait-online)
+      (compute (lambda _
+                 (wait-service-online))))))
+  (run-installer-steps
+   #:steps network-steps
+   #:rewind-strategy 'start))
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
new file mode 100644
index 0000000000..edf0b8c999
--- /dev/null
+++ b/gnu/installer/newt/page.scm
@@ -0,0 +1,530 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt page)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (newt)
+  #:export (draw-info-page
+            draw-connecting-page
+            run-input-page
+            run-error-page
+            run-listbox-selection-page
+            run-scale-page
+            run-checkbox-tree-page
+            run-file-textbox-page))
+
+;;; Commentary:
+;;;
+;;; Some helpers around guile-newt to draw or run generic pages. The
+;;; difference between 'draw' and 'run' terms comes from newt library. A page
+;;; is drawn when the form it contains does not expect any user
+;;; interaction. In that case, it is necessary to call (newt-refresh) to force
+;;; the page to be displayed. When a form is 'run', it is blocked waiting for
+;;; any action from the user (press a button, input some text, ...).
+;;;
+;;; Code:
+
+(define (draw-info-page text title)
+  "Draw an informative page with the given TEXT as content.  Set the title of
+this page to TITLE."
+  (let* ((text-box
+          (make-reflowed-textbox -1 -1 text 40
+                                 #:flags FLAG-BORDER))
+         (grid (make-grid 1 1))
+         (form (make-form)))
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (add-component-to-form form text-box)
+    (make-wrapped-grid-window grid title)
+    (draw-form form)
+    ;; This call is imperative, otherwise the form won't be displayed. See the
+    ;; explanation in the above commentary.
+    (newt-refresh)
+    form))
+
+(define (draw-connecting-page service-name)
+  "Draw a page to indicate a connection in in progress."
+  (draw-info-page
+   (format #f (G_ "Connecting to ~a, please wait.") service-name)
+   (G_ "Connection in progress")))
+
+(define* (run-input-page text title
+                         #:key
+                         (allow-empty-input? #f)
+                         (default-text #f)
+                         (input-field-width 40))
+  "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."
+  (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))
+         (ok-button (make-button -1 -1 (G_ "OK")))
+         (form (make-form)))
+
+    (when default-text
+      (set-entry-text input-entry default-text))
+
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT input-entry
+                    #:pad-top 1)
+    (set-grid-field grid 0 2 GRID-ELEMENT-COMPONENT ok-button
+                    #:pad-top 1)
+
+    (add-components-to-form form text-box input-entry ok-button)
+    (make-wrapped-grid-window grid title)
+    (let ((error-page (lambda ()
+                        (run-error-page (G_ "Please enter a non empty input.")
+                                        (G_ "Empty input")))))
+      (let loop ()
+        (receive (exit-reason argument)
+            (run-form form)
+          (let ((input (entry-value input-entry)))
+            (if (and (not allow-empty-input?)
+                     (eq? exit-reason 'exit-component)
+                     (string=? input ""))
+                (begin
+                  ;; Display the error page.
+                  (error-page)
+                  ;; Set the focus back to the input input field.
+                  (set-current-component form input-entry)
+                  (loop))
+                (begin
+                  (destroy-form-and-pop form)
+                  input))))))))
+
+(define (run-error-page text title)
+  "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))
+         (grid (make-grid 1 2))
+         (ok-button (make-button -1 -1 "OK"))
+         (form (make-form)))
+
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT ok-button
+                    #:pad-top 1)
+
+    ;; Set the background color to red to indicate something went wrong.
+    (newt-set-color COLORSET-ROOT "white" "red")
+    (add-components-to-form form text-box ok-button)
+    (make-wrapped-grid-window grid title)
+    (run-form form)
+    ;; Restore the background to its original color.
+    (newt-set-color COLORSET-ROOT "white" "blue")
+    (destroy-form-and-pop form)))
+
+(define* (run-listbox-selection-page #:key
+                                     info-text
+                                     title
+                                     (info-textbox-width 50)
+                                     listbox-items
+                                     listbox-item->text
+                                     (listbox-height 20)
+                                     (listbox-default-item #f)
+                                     (listbox-allow-multiple? #f)
+                                     (sort-listbox-items? #t)
+                                     (allow-delete? #f)
+                                     (skip-item-procedure?
+                                      (const #f))
+                                     button-text
+                                     (button-callback-procedure
+                                      (const #t))
+                                     (button2-text #f)
+                                     (button2-callback-procedure
+                                      (const #t))
+                                     (listbox-callback-procedure
+                                      identity)
+                                     (hotkey-callback-procedure
+                                      (const #t)))
+  "Run a page asking the user to select an item in a listbox. The page
+contains, stacked vertically from the top to the bottom, an informative text
+set to INFO-TEXT, a listbox and a button. The listbox will be filled with
+LISTBOX-ITEMS converted to text by applying the procedure LISTBOX-ITEM->TEXT
+on every item. The selected item from LISTBOX-ITEMS is returned. The button
+text is set to BUTTON-TEXT and the procedure BUTTON-CALLBACK-PROCEDURE called
+when it is pressed. The procedure LISTBOX-CALLBACK-PROCEDURE is called when an
+item from the listbox is selected (by pressing the <ENTER> key).
+
+INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be
+displayed. LISTBOX-HEIGHT is the height of the listbox.
+
+If LISTBOX-DEFAULT-ITEM is set to the value of one of the items in
+LISTBOX-ITEMS, it will be selected by default. Otherwise, the first element of
+the listbox is selected.
+
+If LISTBOX-ALLOW-MULTIPLE? is set to #t, multiple items from the listbox can
+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).
+
+If ALLOW-DELETE? is #t, the form will return if the <DELETE> key is pressed,
+otherwise nothing will happend.
+
+Each time the listbox current item changes, call SKIP-ITEM-PROCEDURE? with the
+current listbox item as argument. If it returns #t, skip the element and jump
+to the next/previous one depending on the previous item, otherwise do
+nothing."
+
+  (define (fill-listbox listbox items)
+    "Append the given ITEMS to LISTBOX, once they have been converted to text
+with LISTBOX-ITEM->TEXT. Each item appended to the LISTBOX is given a key by
+newt. Save this key by returning an association list under the form:
+
+	((NEWT-LISTBOX-KEY . ITEM) ...)
+
+where NEWT-LISTBOX-KEY is the key returned by APPEND-ENTRY-TO-LISTBOX, when
+ITEM was inserted into LISTBOX."
+    (map (lambda (item)
+           (let* ((text (listbox-item->text item))
+                  (key (append-entry-to-listbox listbox text)))
+             (cons key item)))
+         items))
+
+  (define (sort-listbox-items listbox-items)
+    "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text
+corresponding to each item in the list."
+    (let* ((items (map (lambda (item)
+                         (cons item (listbox-item->text item)))
+                       listbox-items))
+           (sorted-items
+            (sort items (lambda (a b)
+                          (let ((text-a (cdr a))
+                                (text-b (cdr b)))
+                            (string<= text-a text-b))))))
+      (map car sorted-items)))
+
+  ;; Store the last selected listbox item's key.
+  (define last-listbox-key (make-parameter #f))
+
+  (define (previous-key keys key)
+    (let ((index (list-index (cut eq? key <>) keys)))
+      (and index
+           (> index 0)
+           (list-ref keys (- index 1)))))
+
+  (define (next-key keys key)
+    (let ((index (list-index (cut eq? key <>) keys)))
+      (and index
+           (< index (- (length keys) 1))
+           (list-ref keys (+ index 1)))))
+
+  (define (set-default-item listbox listbox-keys default-item)
+    "Set the default item of LISTBOX to DEFAULT-ITEM. LISTBOX-KEYS is the
+association list returned by the FILL-LISTBOX procedure. It is used because
+the current listbox item has to be selected by key."
+    (for-each (match-lambda
+                ((key . item)
+                 (when (equal? item default-item)
+                   (set-current-listbox-entry-by-key listbox key))))
+              listbox-keys))
+
+  (let* ((listbox (make-listbox
+                   -1 -1
+                   listbox-height
+                   (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT
+                           (if listbox-allow-multiple?
+                               FLAG-MULTIPLE
+                               0))))
+         (form (make-form))
+         (info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (button (make-button -1 -1 button-text))
+         (button2 (and button2-text
+                       (make-button -1 -1 button2-text)))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT listbox
+                GRID-ELEMENT-SUBGRID
+                (apply
+                 horizontal-stacked-grid
+                 GRID-ELEMENT-COMPONENT button
+                 `(,@(if button2
+                         (list GRID-ELEMENT-COMPONENT button2)
+                         '())))))
+         (sorted-items (if sort-listbox-items?
+                           (sort-listbox-items listbox-items)
+                           listbox-items))
+         (keys (fill-listbox listbox sorted-items)))
+
+    ;; On every listbox element change, check if we need to skip it. If yes,
+    ;; depending on the 'last-listbox-key', jump forward or backward. If no,
+    ;; do nothing.
+    (add-component-callback
+     listbox
+     (lambda (component)
+       (let* ((current-key (current-listbox-entry listbox))
+              (listbox-keys (map car keys))
+              (last-key (last-listbox-key))
+              (item (assoc-ref keys current-key))
+              (prev-key (previous-key listbox-keys current-key))
+              (next-key (next-key listbox-keys current-key)))
+         ;; Update last-listbox-key before a potential call to
+         ;; set-current-listbox-entry-by-key, because it will immediately
+         ;; cause this callback to be called for the new entry.
+         (last-listbox-key current-key)
+         (when (skip-item-procedure? item)
+           (when (eq? prev-key last-key)
+             (if next-key
+                 (set-current-listbox-entry-by-key listbox next-key)
+                 (set-current-listbox-entry-by-key listbox prev-key)))
+           (when (eq? next-key last-key)
+             (if prev-key
+                 (set-current-listbox-entry-by-key listbox prev-key)
+                 (set-current-listbox-entry-by-key listbox next-key)))))))
+
+    (when listbox-default-item
+      (set-default-item listbox keys listbox-default-item))
+
+    (when allow-delete?
+      (form-add-hotkey form KEY-DELETE))
+
+    (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 button)
+               (button-callback-procedure))
+              ((and button2
+                    (components=? argument button2))
+               (button2-callback-procedure))
+              ((components=? argument listbox)
+               (if listbox-allow-multiple?
+                   (let* ((entries (listbox-selection listbox))
+                          (items (map (lambda (entry)
+                                        (assoc-ref keys entry))
+                                      entries)))
+                     (listbox-callback-procedure items))
+                   (let* ((entry (current-listbox-entry listbox))
+                          (item (assoc-ref keys entry)))
+                     (listbox-callback-procedure item))))))
+            ((exit-hotkey)
+             (let* ((entry (current-listbox-entry listbox))
+                    (item (assoc-ref keys entry)))
+               (hotkey-callback-procedure argument item)))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
+(define* (run-scale-page #:key
+                         title
+                         info-text
+                         (info-textbox-width 50)
+                         (scale-width 40)
+                         (scale-full-value 100)
+                         scale-update-proc
+                         (max-scale-update 5))
+  "Run a page with a progress bar (called 'scale' in newt). The given
+INFO-TEXT is displayed in a textbox above the scale. The width of the textbox
+is set to INFO-TEXTBOX-WIDTH. The width of the scale is set to
+SCALE-WIDTH. SCALE-FULL-VALUE indicates the value that correspond to 100% of
+the scale.
+
+The procedure SCALE-UPDATE-PROC shall return a new scale
+value. SCALE-UPDATE-PROC will be called until the returned value is superior
+or equal to SCALE-FULL-VALUE, but no more than MAX-SCALE-UPDATE times. An
+error is raised if the MAX-SCALE-UPDATE limit is reached."
+  (let* ((info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (scale (make-scale -1 -1 scale-width scale-full-value))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT scale))
+         (form (make-form)))
+
+    (add-form-to-grid grid form #t)
+    (make-wrapped-grid-window grid title)
+
+    (draw-form form)
+    ;; This call is imperative, otherwise the form won't be displayed. See the
+    ;; explanation in the above commentary.
+    (newt-refresh)
+
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (let loop ((i max-scale-update)
+                   (last-value 0))
+          (let ((value (scale-update-proc last-value)))
+            (set-scale-value scale value)
+            ;; Same as above.
+            (newt-refresh)
+            (unless (>= value scale-full-value)
+              (if (> i 0)
+                  (loop (- i 1) value)
+                  (error "Max scale updates reached."))))))
+      (lambda ()
+        (destroy-form-and-pop form)))))
+
+(define* (run-checkbox-tree-page #:key
+                                 info-text
+                                 title
+                                 items
+                                 item->text
+                                 (info-textbox-width 50)
+                                 (checkbox-tree-height 10)
+                                 (ok-button-callback-procedure
+                                  (const #t))
+                                 (exit-button-callback-procedure
+                                  (const #t)))
+  "Run a page allowing the user to select one or multiple items among ITEMS in
+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.
+
+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.
+
+OK-BUTTON-CALLBACK-PROCEDURE is called when the 'Ok' button is pressed.
+EXIT-BUTTON-CALLBACK-PROCEDURE is called when the 'Exit' button is
+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))
+
+  (let* ((checkbox-tree
+          (make-checkboxtree -1 -1
+                             checkbox-tree-height
+                             FLAG-BORDER))
+         (info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (ok-button (make-button -1 -1 (G_ "OK")))
+         (exit-button (make-button -1 -1 (G_ "Exit")))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT checkbox-tree
+                GRID-ELEMENT-SUBGRID
+                (horizontal-stacked-grid
+                 GRID-ELEMENT-COMPONENT ok-button
+                 GRID-ELEMENT-COMPONENT exit-button)))
+         (keys (fill-checkbox-tree checkbox-tree items))
+         (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)
+               (let* ((entries (current-checkbox-selection checkbox-tree))
+                      (current-items (map (lambda (entry)
+                                            (assoc-ref keys entry))
+                                          entries)))
+                 (ok-button-callback-procedure)
+                 current-items))
+              ((components=? argument exit-button)
+               (exit-button-callback-procedure))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
+(define* (run-file-textbox-page #:key
+                                info-text
+                                title
+                                file
+                                (info-textbox-width 50)
+                                (file-textbox-width 50)
+                                (file-textbox-height 30)
+                                (exit-button? #t)
+                                (ok-button-callback-procedure
+                                 (const #t))
+                                (exit-button-callback-procedure
+                                 (const #t)))
+  (let* ((info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (file-text (read-all file))
+         (file-textbox
+          (make-textbox -1 -1
+                        file-textbox-width
+                        file-textbox-height
+                        (logior FLAG-SCROLL FLAG-BORDER)))
+         (ok-button (make-button -1 -1 (G_ "OK")))
+         (exit-button (make-button -1 -1 (G_ "Exit")))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT file-textbox
+                GRID-ELEMENT-SUBGRID
+                (apply
+                 horizontal-stacked-grid
+                 GRID-ELEMENT-COMPONENT ok-button
+                 `(,@(if exit-button?
+                         (list GRID-ELEMENT-COMPONENT exit-button)
+                         '())))))
+         (form (make-form)))
+
+    (set-textbox-text file-textbox file-text)
+    (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)
+               (ok-button-callback-procedure))
+              ((and exit-button?
+                    (components=? argument exit-button))
+               (exit-button-callback-procedure))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
new file mode 100644
index 0000000000..d4c91edc66
--- /dev/null
+++ b/gnu/installer/newt/partition.scm
@@ -0,0 +1,766 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt partition)
+  #:use-module (gnu installer parted)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:use-module (parted)
+  #:export (run-partioning-page))
+
+(define (button-exit-action)
+  "Raise the &installer-step-abort condition."
+  (raise
+   (condition
+    (&installer-step-abort))))
+
+(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")))
+         (result (run-listbox-selection-page
+                  #:info-text (G_ "Please select a partitioning scheme.")
+                  #:title (G_ "Partition scheme")
+                  #:listbox-items items
+                  #:listbox-item->text cdr
+                  #:button-text (G_ "Exit")
+                  #:button-callback-procedure button-exit-action)))
+    (car result)))
+
+(define (draw-formatting-page)
+  "Draw a page to indicate partitions are being formated."
+  (draw-info-page
+   (format #f (G_ "Partition formatting is in progress, please wait."))
+   (G_ "Preparing partitions")))
+
+(define (run-device-page devices)
+  "Run a page asking the user to select a device among those in the given
+DEVICES list."
+  (define (device-items)
+    (map (lambda (device)
+           `(,device . ,(device-description device)))
+         devices))
+
+  (let* ((result (run-listbox-selection-page
+                  #:info-text (G_ "Please select a disk.")
+                  #:title (G_ "Disk")
+                  #:listbox-items (device-items)
+                  #:listbox-item->text cdr
+                  #:button-text (G_ "Exit")
+                  #:button-callback-procedure button-exit-action))
+         (device (car result)))
+    device))
+
+(define (run-label-page button-text button-callback)
+  "Run a page asking the user to select a partition table label."
+  (run-listbox-selection-page
+   #:info-text (G_ "Select a new partition table type. \
+Be careful, all data on the disk will be lost.")
+   #:title (G_ "Partition table")
+   #:listbox-items '("msdos" "gpt")
+   #:listbox-item->text identity
+   #:button-text button-text
+   #:button-callback-procedure button-callback))
+
+(define (run-type-page partition)
+  "Run a page asking the user to select a partition type."
+  (let* ((disk (partition-disk partition))
+         (partitions (disk-partitions disk))
+         (other-extended-partitions?
+          (any extended-partition? partitions))
+         (items
+          `(normal ,@(if other-extended-partitions?
+                         '()
+                         '(extended)))))
+    (run-listbox-selection-page
+     #:info-text (G_ "Please select a partition type.")
+     #:title (G_ "Partition type")
+     #:listbox-items items
+     #:listbox-item->text symbol->string
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Exit")
+     #:button-callback-procedure button-exit-action)))
+
+(define (run-fs-type-page)
+  "Run a page asking the user to select a file-system type."
+  (run-listbox-selection-page
+   #:info-text (G_ "Please select the file-system type for this partition.")
+   #:title (G_ "File-system type")
+   #:listbox-items '(ext4 btrfs fat32 swap)
+   #:listbox-item->text user-fs-type-name
+   #:sort-listbox-items? #f
+   #:button-text (G_ "Exit")
+   #:button-callback-procedure button-exit-action))
+
+(define (inform-can-create-partition? user-partition)
+  "Return #t if it is possible to create USER-PARTITION. This is determined by
+calling CAN-CREATE-PARTITION? procedure. If an exception is raised, catch it
+an inform the user with an appropriate error-page and return #f."
+  (guard (c ((max-primary-exceeded? c)
+            (run-error-page
+             (G_ "Primary partitions count exceeded.")
+             (G_ "Creation error"))
+            #f)
+           ((extended-creation-error? c)
+            (run-error-page
+             (G_ "Extended partition creation error.")
+             (G_ "Creation error"))
+            #f)
+           ((logical-creation-error? c)
+            (run-error-page
+             (G_ "Logical partition creation error.")
+             (G_ "Creation error"))
+            #f))
+    (can-create-partition? user-partition)))
+
+(define (prompt-luks-passwords user-partitions)
+  "Prompt for the luks passwords of the encrypted partitions in
+USER-PARTITIONS list. Return this list with password fields filled-in."
+  (map (lambda (user-part)
+         (let* ((crypt-label (user-partition-crypt-label user-part))
+                (file-name (user-partition-file-name user-part))
+                (password-page
+                 (lambda ()
+                   (run-input-page
+                    (format #f (G_ "Please enter the password for the \
+encryption of partition ~a (label: ~a).") file-name crypt-label)
+                    (G_ "Password required"))))
+                (password-confirm-page
+                 (lambda ()
+                   (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")))))
+           (if crypt-label
+               (let loop ()
+                 (let ((password (password-page))
+                       (confirmation (password-confirm-page)))
+                   (if (string=? password confirmation)
+                       (user-partition
+                        (inherit user-part)
+                        (crypt-password password))
+                       (begin
+                         (run-error-page
+                          (G_ "Password mismatch, please try again.")
+                          (G_ "Password error"))
+                         (loop)))))
+               user-part)))
+       user-partitions))
+
+(define* (run-partition-page target-user-partition
+                             #:key
+                             (default-item #f))
+  "Run a page allowing the user to edit the given TARGET-USER-PARTITION
+record. If the argument DEFAULT-ITEM is passed, use it to select the current
+listbox item. This is used to avoid the focus to switch back to the first
+listbox entry while calling this procedure recursively."
+
+  (define (numeric-size device size)
+    "Parse the given SIZE on DEVICE and return it."
+    (call-with-values
+        (lambda ()
+          (unit-parse size device))
+      (lambda (value range)
+        value)))
+
+  (define (numeric-size-range device size)
+    "Parse the given SIZE on DEVICE and return the associated RANGE."
+    (call-with-values
+        (lambda ()
+          (unit-parse size device))
+      (lambda (value range)
+        range)))
+
+  (define* (fill-user-partition-geom user-part
+                                     #:key
+                                     device (size #f) start end)
+    "Return the given USER-PART with the START, END and SIZE fields set to the
+eponym arguments. Use UNIT-FORMAT-CUSTOM to format START and END arguments as
+sectors on DEVICE."
+    (user-partition
+     (inherit user-part)
+     (size size)
+     (start (unit-format-custom device start UNIT-SECTOR))
+     (end (unit-format-custom device end UNIT-SECTOR))))
+
+  (define (apply-user-partition-changes user-part)
+    "Set the name, file-system type and boot flag on the partition specified
+by USER-PART, if it is applicable for the partition type."
+    (let* ((partition (user-partition-parted-object user-part))
+           (disk (partition-disk partition))
+           (disk-type (disk-disk-type disk))
+           (device (disk-device disk))
+           (has-name? (disk-type-check-feature
+                       disk-type
+                       DISK-TYPE-FEATURE-PARTITION-NAME))
+           (name (user-partition-name user-part))
+           (fs-type (filesystem-type-get
+                     (user-fs-type-name
+                      (user-partition-fs-type user-part))))
+           (bootable? (user-partition-bootable? user-part))
+           (esp? (user-partition-esp? user-part))
+           (flag-bootable?
+            (partition-is-flag-available? partition PARTITION-FLAG-BOOT))
+           (flag-esp?
+            (partition-is-flag-available? partition PARTITION-FLAG-ESP)))
+      (when (and has-name? name)
+        (partition-set-name partition name))
+      (partition-set-system partition fs-type)
+      (when flag-bootable?
+        (partition-set-flag partition
+                            PARTITION-FLAG-BOOT
+                            (if bootable? 1 0)))
+      (when flag-esp?
+        (partition-set-flag partition
+                            PARTITION-FLAG-ESP
+                            (if esp? 1 0)))
+      #t))
+
+  (define (listbox-action listbox-item)
+    (let* ((item (car listbox-item))
+           (partition (user-partition-parted-object
+                       target-user-partition))
+           (disk (partition-disk partition))
+           (device (disk-device disk)))
+      (list
+       item
+       (case item
+         ((name)
+          (let* ((old-name (user-partition-name target-user-partition))
+                 (name
+                  (run-input-page (G_ "Please enter the partition gpt name.")
+                                  (G_ "Partition name")
+                                  #:default-text old-name)))
+            (user-partition
+             (inherit target-user-partition)
+             (name name))))
+         ((type)
+          (let ((new-type (run-type-page partition)))
+            (user-partition
+             (inherit target-user-partition)
+             (type new-type))))
+         ((bootable)
+          (user-partition
+           (inherit target-user-partition)
+           (bootable? (not (user-partition-bootable?
+                            target-user-partition)))))
+         ((esp?)
+          (let ((new-esp? (not (user-partition-esp?
+                                target-user-partition))))
+            (user-partition
+             (inherit target-user-partition)
+             (esp? new-esp?)
+             (mount-point (if new-esp?
+                              (default-esp-mount-point)
+                              "")))))
+         ((crypt-label)
+          (let* ((label (user-partition-crypt-label
+                         target-user-partition))
+                 (new-label
+                  (and (not label)
+                       (run-input-page
+                        (G_ "Please enter the encrypted label")
+                        (G_ "Encryption label")))))
+            (user-partition
+             (inherit target-user-partition)
+             (need-formatting? #t)
+             (crypt-label new-label))))
+         ((need-formatting?)
+          (user-partition
+           (inherit target-user-partition)
+           (need-formatting?
+            (not (user-partition-need-formatting?
+                  target-user-partition)))))
+         ((size)
+          (let* ((old-size (user-partition-size target-user-partition))
+                 (max-size-value (partition-length partition))
+                 (max-size (unit-format device max-size-value))
+                 (start (partition-start partition))
+                 (size (run-input-page
+                        (format #f (G_ "Please enter the size of the partition.\
+ The maximum size is ~a.") max-size)
+                        (G_ "Partition size")
+                        #:default-text (or old-size max-size)))
+                 (size-percentage (read-percentage size))
+                 (size-value (if size-percentage
+                                 (nearest-exact-integer
+                                  (/ (* max-size-value size-percentage)
+                                     100))
+                                 (numeric-size device size)))
+                 (end (and size-value
+                           (+ start size-value)))
+                 (size-range (numeric-size-range device size))
+                 (size-range-ok? (and size-range
+                                      (< (+ start
+                                            (geometry-start size-range))
+                                         (partition-end partition)))))
+            (cond
+             ((and size-percentage (> size-percentage 100))
+              (run-error-page
+               (G_ "The percentage can not be superior to 100.")
+               (G_ "Size error"))
+              target-user-partition)
+             ((not size-value)
+              (run-error-page
+               (G_ "The requested size is incorrectly formatted, or too large.")
+               (G_ "Size error"))
+              target-user-partition)
+             ((not (or size-percentage size-range-ok?))
+              (run-error-page
+               (G_ "The request size is superior to the maximum size.")
+               (G_ "Size error"))
+              target-user-partition)
+             (else
+              (fill-user-partition-geom target-user-partition
+                                        #:device device
+                                        #:size size
+                                        #:start start
+                                        #:end end)))))
+         ((fs-type)
+          (let ((fs-type (run-fs-type-page)))
+            (user-partition
+             (inherit target-user-partition)
+             (fs-type fs-type))))
+         ((mount-point)
+          (let* ((old-mount (or (user-partition-mount-point
+                                 target-user-partition)
+                                ""))
+                 (mount
+                  (run-input-page
+                   (G_ "Please enter the desired mounting point for this \
+partition. Leave this field empty if you don't want to set a mounting point.")
+                   (G_ "Mounting point")
+                   #:default-text old-mount
+                   #:allow-empty-input? #t)))
+            (user-partition
+             (inherit target-user-partition)
+             (mount-point (and (not (string=? mount ""))
+                               mount)))))))))
+
+  (define (button-action)
+    (let* ((partition (user-partition-parted-object
+                       target-user-partition))
+           (prev-part (partition-prev partition))
+           (disk (partition-disk partition))
+           (device (disk-device disk))
+           (creation? (freespace-partition? partition))
+           (start (partition-start partition))
+           (end (partition-end partition))
+           (new-user-partition
+            (if (user-partition-start target-user-partition)
+                target-user-partition
+                (fill-user-partition-geom target-user-partition
+                                          #:device device
+                                          #:start start
+                                          #:end end))))
+      ;; It the backend PARTITION has free-space type, it means we are
+      ;; creating a new partition, otherwise, we are editing an already
+      ;; existing PARTITION.
+      (if creation?
+          (let* ((ok-create-partition?
+                  (inform-can-create-partition? new-user-partition))
+                 (new-partition
+                  (and ok-create-partition?
+                       (mkpart disk
+                               new-user-partition
+                               #:previous-partition prev-part))))
+            (and new-partition
+                 (user-partition
+                  (inherit new-user-partition)
+                  (need-formatting? #t)
+                  (file-name (partition-get-path new-partition))
+                  (disk-file-name (device-path device))
+                  (parted-object new-partition))))
+          (and (apply-user-partition-changes new-user-partition)
+               new-user-partition))))
+
+  (let* ((items (user-partition-description target-user-partition))
+         (partition (user-partition-parted-object
+                     target-user-partition))
+         (disk (partition-disk partition))
+         (device (disk-device disk))
+         (file-name (device-path device))
+         (number-str (partition-print-number partition))
+         (type (user-partition-type target-user-partition))
+         (type-str (symbol->string type))
+         (start (unit-format device (partition-start partition)))
+         (creation? (freespace-partition? partition))
+         (default-item (and default-item
+                            (find (lambda (item)
+                                    (eq? (car item) default-item))
+                                  items)))
+         (result
+          (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)))
+           #:title (if creation?
+                       (G_ "Partition creation")
+                       (G_ "Partition edit"))
+           #:listbox-items items
+           #:listbox-item->text cdr
+           #:sort-listbox-items? #f
+           #:listbox-default-item default-item
+           #:button-text (G_ "OK")
+           #:listbox-callback-procedure listbox-action
+           #:button-callback-procedure button-action)))
+    (match result
+      ((item new-user-partition)
+       (run-partition-page new-user-partition
+                           #:default-item item))
+      (else result))))
+
+(define* (run-disk-page disks
+                        #:optional (user-partitions '())
+                        #:key (guided? #f))
+  "Run a page allowing to edit the partition tables of the given DISKS. If
+specified, USER-PARTITIONS is a list of <user-partition> records associated to
+the partitions on DISKS."
+
+  (define (other-logical-partitions? partitions)
+    "Return #t if at least one of the partition in PARTITIONS list is a
+logical partition, return #f otherwise."
+    (any logical-partition? partitions))
+
+  (define (other-non-logical-partitions? partitions)
+    "Return #t is at least one of the partitions in PARTITIONS list is not a
+logical partition, return #f otherwise."
+    (let ((non-logical-partitions
+           (remove logical-partition? partitions)))
+      (or (any normal-partition? non-logical-partitions)
+          (any freespace-partition? non-logical-partitions))))
+
+  (define (add-tree-symbols partitions descriptions)
+    "Concatenate tree symbols to the given DESCRIPTIONS list and return
+it. The PARTITIONS list is the list of partitions described in
+DESCRIPTIONS. The tree symbols are used to indicate the partition's disk and
+for logical partitions, the extended partition which includes them."
+    (match descriptions
+      (() '())
+      ((description . rest-descriptions)
+       (match partitions
+         ((partition . rest-partitions)
+          (if (null? rest-descriptions)
+              (list (if (logical-partition? partition)
+                        (string-append " ┗━ " description)
+                        (string-append "┗━  " description)))
+              (cons (cond
+                     ((extended-partition? partition)
+                      (if (other-non-logical-partitions? rest-partitions)
+                          (string-append "┣┳  " description)
+                          (string-append "┗┳  " description)))
+                     ((logical-partition? partition)
+                      (if (other-logical-partitions? rest-partitions)
+                          (if (other-non-logical-partitions? rest-partitions)
+                              (string-append "┃┣━ " description)
+                              (string-append " ┣━ " description))
+                          (if (other-non-logical-partitions? rest-partitions)
+                              (string-append "┃┗━ " description)
+                              (string-append " ┗━ " description))))
+                     (else
+                      (string-append "┣━  " description)))
+                    (add-tree-symbols rest-partitions
+                                      rest-descriptions))))))))
+
+  (define (skip-item? item)
+    (eq? (car item) 'skip))
+
+  (define (disk-items)
+    "Return the list of strings describing DISKS."
+    (let loop ((disks disks))
+      (match disks
+        (() '())
+        ((disk . rest)
+         (let* ((device (disk-device disk))
+                (partitions (disk-partitions disk))
+                (partitions*
+                 (filter-map
+                  (lambda (partition)
+                    (and (not (metadata-partition? partition))
+                         (not (small-freespace-partition? device
+                                                          partition))
+                         partition))
+                  partitions))
+                (descriptions (add-tree-symbols
+                               partitions*
+                               (partitions-descriptions partitions*
+                                                        user-partitions)))
+                (partition-items (map cons partitions* descriptions)))
+           (append
+            `((,disk . ,(device-description device disk))
+              ,@partition-items
+              ,@(if (null? rest)
+                    '()
+                    '((skip . ""))))
+            (loop rest)))))))
+
+  (define (remove-user-partition-by-partition user-partitions partition)
+    "Return the USER-PARTITIONS list with the record with the given PARTITION
+object removed. If PARTITION is an extended partition, also remove all logical
+partitions from USER-PARTITIONS."
+    (remove (lambda (p)
+              (let ((cur-partition (user-partition-parted-object p)))
+                (or (equal? cur-partition partition)
+                    (and (extended-partition? partition)
+                         (logical-partition? cur-partition)))))
+            user-partitions))
+
+  (define (remove-user-partition-by-disk user-partitions disk)
+    "Return the USER-PARTITIONS list with the <user-partition> records located
+on given DISK removed."
+    (remove (lambda (p)
+              (let* ((partition (user-partition-parted-object p))
+                     (cur-disk (partition-disk partition)))
+                (equal? cur-disk disk)))
+            user-partitions))
+
+  (define (update-user-partitions user-partitions new-user-partition)
+    "Update or insert NEW-USER-PARTITION record in USER-PARTITIONS list
+depending if one of the <user-partition> record in USER-PARTITIONS has the
+same PARTITION object as NEW-USER-PARTITION."
+    (let* ((partition (user-partition-parted-object new-user-partition))
+           (user-partitions*
+            (remove-user-partition-by-partition user-partitions
+                                                partition)))
+      (cons new-user-partition user-partitions*)))
+
+  (define (button-ok-action)
+    "Commit the modifications to all DISKS and return #t."
+    (for-each (lambda (disk)
+                (disk-commit disk))
+              disks)
+    #t)
+
+  (define (listbox-action listbox-item)
+    "A disk or a partition has been selected. If it's a disk, ask for a label
+to create a new partition table. If it is a partition, propose the user to
+edit it."
+    (let ((item (car listbox-item)))
+      (cond
+       ((disk? item)
+        (let ((label (run-label-page (G_ "Back") (const #f))))
+          (if label
+              (let* ((device (disk-device item))
+                     (new-disk (mklabel device label))
+                     (commit-new-disk (disk-commit new-disk))
+                     (other-disks (remove (lambda (disk)
+                                            (equal? disk item))
+                                          disks))
+                     (new-user-partitions
+                      (remove-user-partition-by-disk user-partitions item)))
+                (disk-destroy item)
+                `((disks . ,(cons new-disk other-disks))
+                  (user-partitions . ,new-user-partitions)))
+              `((disks . ,disks)
+                (user-partitions . ,user-partitions)))))
+       ((partition? item)
+        (let* ((partition item)
+               (disk (partition-disk partition))
+               (device (disk-device disk))
+               (existing-user-partition
+                (find-user-partition-by-parted-object user-partitions
+                                                      partition))
+               (edit-user-partition
+                (or existing-user-partition
+                    (partition->user-partition partition))))
+          `((disks . ,disks)
+            (user-partitions . ,user-partitions)
+            (edit-user-partition . ,edit-user-partition)))))))
+
+  (define (hotkey-action key listbox-item)
+    "The DELETE key has been pressed on a disk or a partition item."
+    (let ((item (car listbox-item))
+          (default-result
+            `((disks . ,disks)
+              (user-partitions . ,user-partitions))))
+      (cond
+       ((disk? item)
+        (let* ((device (disk-device item))
+               (file-name (device-path device))
+               (info-text
+                (format #f (G_ "Are you sure you want to delete everything on disk ~a?")
+                        file-name))
+               (result (choice-window (G_ "Delete disk")
+                                      (G_ "OK")
+                                      (G_ "Exit")
+                                      info-text)))
+          (case result
+            ((1)
+             (disk-delete-all item)
+             `((disks . ,disks)
+               (user-partitions
+                . ,(remove-user-partition-by-disk user-partitions item))))
+            (else
+             default-result))))
+       ((partition? item)
+        (if (freespace-partition? item)
+            (run-error-page (G_ "You cannot delete a free space area.")
+                            (G_ "Delete partition"))
+            (let* ((disk (partition-disk item))
+                   (number-str (partition-print-number item))
+                   (info-text
+                    (format #f (G_ "Are you sure you want to delete partition ~a?")
+                            number-str))
+                   (result (choice-window (G_ "Delete partition")
+                                          (G_ "OK")
+                                          (G_ "Exit")
+                                          info-text)))
+              (case result
+                ((1)
+                 (let ((new-user-partitions
+                        (remove-user-partition-by-partition user-partitions
+                                                            item)))
+                   (disk-delete-partition disk item)
+                   `((disks . ,disks)
+                     (user-partitions . ,new-user-partitions))))
+                (else
+                 default-result))))))))
+
+  (let* ((info-text (G_ "You can change a disk's partition table by \
+selecting it and pressing ENTER. You can also edit a partition by selecting it \
+and pressing ENTER, or remove it by pressing DELETE. To create a new \
+partition, select a free space area and press ENTER.
+
+At least one partition must have its mounting point set to '/'."))
+         (guided-info-text (format #f (G_ "This is the proposed \
+partitioning. It is still possible to edit it or to go back to install menu \
+by pressing the Exit button.~%~%")))
+         (result
+          (run-listbox-selection-page
+           #:info-text (if guided?
+                           (string-append guided-info-text info-text)
+                           info-text)
+
+          #:title (if guided?
+                      (G_ "Guided partitioning")
+                      (G_ "Manual partitioning"))
+          #:info-textbox-width 70
+          #:listbox-items (disk-items)
+          #:listbox-item->text cdr
+          #:sort-listbox-items? #f
+          #:skip-item-procedure? skip-item?
+          #:allow-delete? #t
+          #:button-text (G_ "OK")
+          #:button-callback-procedure button-ok-action
+          #:button2-text (G_ "Exit")
+          #:button2-callback-procedure button-exit-action
+          #:listbox-callback-procedure listbox-action
+          #:hotkey-callback-procedure hotkey-action)))
+    (if (eq? result #t)
+        (let ((user-partitions-ok?
+               (guard
+                   (c ((no-root-mount-point? c)
+                       (run-error-page
+                        (G_ "No root mount point found.")
+                        (G_ "Missing mount point"))
+                       #f))
+                 (check-user-partitions user-partitions))))
+          (if user-partitions-ok?
+              (begin
+                (for-each (cut disk-destroy <>) disks)
+                user-partitions)
+              (run-disk-page disks user-partitions
+                             #:guided? guided?)))
+        (let* ((result-disks (assoc-ref result 'disks))
+               (result-user-partitions (assoc-ref result
+                                                  'user-partitions))
+               (edit-user-partition (assoc-ref result
+                                               'edit-user-partition))
+               (can-create-partition?
+                (and edit-user-partition
+                     (inform-can-create-partition? edit-user-partition)))
+               (new-user-partition (and edit-user-partition
+                                        can-create-partition?
+                                        (run-partition-page
+                                         edit-user-partition)))
+               (new-user-partitions
+                (if new-user-partition
+                    (update-user-partitions result-user-partitions
+                                            new-user-partition)
+                    result-user-partitions)))
+          (run-disk-page result-disks new-user-partitions
+                         #:guided? guided?)))))
+
+(define (run-partioning-page)
+  "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")))
+           (result (run-listbox-selection-page
+                    #:info-text (G_ "Please select a partitioning method.")
+                    #:title (G_ "Partitioning method")
+                    #:listbox-items items
+                    #:listbox-item->text cdr
+                    #:button-text (G_ "Exit")
+                    #:button-callback-procedure button-exit-action))
+           (method (car result)))
+      (cond
+       ((or (eq? method 'entire)
+            (eq? method 'entire-encrypted))
+         (let* ((device (run-device-page devices))
+                (disk-type (disk-probe device))
+                (disk (if disk-type
+                          (disk-new device)
+                          (let* ((label (run-label-page
+                                         (G_ "Exit")
+                                         button-exit-action))
+                                 (disk (mklabel device label)))
+                            (disk-commit disk)
+                            disk)))
+                (scheme (symbol-append method '- (run-scheme-page)))
+                (user-partitions (append
+                                  (auto-partition disk #:scheme scheme)
+                                  (create-special-user-partitions
+                                   (disk-partitions disk)))))
+           (run-disk-page (list disk) user-partitions
+                          #:guided? #t)))
+       ((eq? method 'manual)
+         (let* ((disks (filter-map disk-new devices))
+                (user-partitions (append-map
+                                  create-special-user-partitions
+                                  (map disk-partitions disks)))
+                (result-user-partitions (run-disk-page disks
+                                                       user-partitions)))
+           result-user-partitions)))))
+
+  (init-parted)
+  (let* ((non-install-devices (non-install-devices))
+         (user-partitions (run-page non-install-devices))
+         (user-partitions-with-pass (prompt-luks-passwords
+                                     user-partitions))
+         (form (draw-formatting-page)))
+    ;; Make sure the disks are not in use before proceeding to formatting.
+    (free-parted non-install-devices)
+    (format-user-partitions user-partitions-with-pass)
+    (destroy-form-and-pop form)
+    user-partitions))
diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm
new file mode 100644
index 0000000000..6bcb6244ae
--- /dev/null
+++ b/gnu/installer/newt/services.scm
@@ -0,0 +1,48 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt services)
+  #:use-module (gnu installer services)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-services-page))
+
+(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))))))
+
+(define (run-services-page)
+  (run-desktop-environments-cbt-page))
diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm
new file mode 100644
index 0000000000..6c96ee55b1
--- /dev/null
+++ b/gnu/installer/newt/timezone.scm
@@ -0,0 +1,83 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt timezone)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer timezone)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (run-timezone-page))
+
+;; Heigth of the listbox displaying timezones.
+(define timezone-listbox-heigth (make-parameter 20))
+
+;; Information textbox width.
+(define info-textbox-width (make-parameter 40))
+
+(define (fill-timezones listbox timezones)
+  "Fill the given LISTBOX with TIMEZONES. Return an association list
+correlating listbox keys with timezones."
+  (map (lambda (timezone)
+         (let ((key (append-entry-to-listbox listbox timezone)))
+           (cons key timezone)))
+       timezones))
+
+(define (run-timezone-page zonetab)
+  "Run a page displaying available timezones, grouped by regions. The user is
+invited to select a timezone. The selected timezone, under Posix format is
+returned."
+  (define (all-but-last list)
+    (reverse (cdr (reverse list))))
+
+  (define (run-page timezone-tree)
+    (define (loop path)
+      (let ((timezones (locate-childrens timezone-tree path)))
+        (run-listbox-selection-page
+         #:title (G_ "Timezone")
+         #:info-text (G_ "Please select a timezone.")
+         #:listbox-items timezones
+         #:listbox-item->text identity
+         #:button-text (if (null? path)
+                           (G_ "Exit")
+                           (G_ "Back"))
+         #:button-callback-procedure
+         (if (null? path)
+             (lambda _
+               (raise
+                (condition
+                 (&installer-step-abort))))
+             (lambda _
+               (loop (all-but-last path))))
+         #:listbox-callback-procedure
+         (lambda (timezone)
+           (let* ((timezone* (append path (list timezone)))
+                  (tz (timezone->posix-tz timezone*)))
+             (if (timezone-has-child? timezone-tree timezone*)
+                 (loop timezone*)
+                 tz))))))
+    (loop '()))
+
+  (let ((timezone-tree (zonetab->timezone-tree zonetab)))
+    (run-page timezone-tree)))
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
new file mode 100644
index 0000000000..59b1913cfc
--- /dev/null
+++ b/gnu/installer/newt/user.scm
@@ -0,0 +1,175 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt user)
+  #:use-module (gnu installer user)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (run-user-page))
+
+(define (run-user-add-page)
+  (define (pad-label label)
+    (string-pad-right label 20))
+
+  (let* ((label-name
+          (make-label -1 -1 (pad-label (G_ "Name"))))
+         (label-home-directory
+          (make-label -1 -1 (pad-label (G_ "Home directory"))))
+         (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))
+         (button-grid (make-grid 1 1))
+         (ok-button (make-button -1 -1 (G_ "OK")))
+         (grid (make-grid 1 2))
+         (title (G_ "User creation"))
+         (set-entry-grid-field
+          (cut set-grid-field entry-grid <> <> GRID-ELEMENT-COMPONENT <>))
+         (form (make-form)))
+
+    (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-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button)
+
+    (add-component-callback
+     entry-name
+     (lambda (component)
+       (set-entry-text entry-home-directory
+                       (string-append "/home/" (entry-value entry-name)))))
+
+    (add-components-to-form form
+                            label-name label-home-directory
+                            entry-name entry-home-directory
+                            ok-button)
+
+    (make-wrapped-grid-window (vertically-stacked-grid
+                               GRID-ELEMENT-SUBGRID entry-grid
+                               GRID-ELEMENT-SUBGRID button-grid)
+                              title)
+    (let ((error-page
+           (lambda ()
+             (run-error-page (G_ "Empty inputs are not allowed.")
+                             (G_ "Empty input")))))
+      (receive (exit-reason argument)
+          (run-form form)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (when (eq? exit-reason 'exit-component)
+              (cond
+               ((components=? argument ok-button)
+                (let ((name (entry-value entry-name))
+                      (home-directory (entry-value entry-home-directory)))
+                  (if (or (string=? name "")
+                          (string=? home-directory ""))
+                      (begin
+                        (error-page)
+                        (run-user-add-page))
+                      (user
+                       (name name)
+                       (home-directory home-directory))))))))
+          (lambda ()
+            (destroy-form-and-pop form)))))))
+
+(define (run-user-page)
+  (define (run users)
+    (let* ((listbox (make-listbox
+                     -1 -1 10
+                     (logior FLAG-SCROLL FLAG-BORDER)))
+           (info-textbox
+            (make-reflowed-textbox
+             -1 -1
+             (G_ "Please add at least one user to system\
+ using the 'Add' button.")
+             40 #:flags FLAG-BORDER))
+           (add-button (make-compact-button -1 -1 (G_ "Add")))
+           (del-button (make-compact-button -1 -1 (G_ "Delete")))
+           (listbox-button-grid
+            (apply
+             vertically-stacked-grid
+             GRID-ELEMENT-COMPONENT add-button
+             `(,@(if (null? users)
+                     '()
+                     (list GRID-ELEMENT-COMPONENT del-button)))))
+           (ok-button (make-button -1 -1 (G_ "OK")))
+           (exit-button (make-button -1 -1 (G_ "Exit")))
+           (title "User creation")
+           (grid
+            (vertically-stacked-grid
+             GRID-ELEMENT-COMPONENT info-textbox
+             GRID-ELEMENT-SUBGRID (horizontal-stacked-grid
+                                   GRID-ELEMENT-COMPONENT listbox
+                                   GRID-ELEMENT-SUBGRID listbox-button-grid)
+             GRID-ELEMENT-SUBGRID (horizontal-stacked-grid
+                                   GRID-ELEMENT-COMPONENT ok-button
+                                   GRID-ELEMENT-COMPONENT exit-button)))
+           (sorted-users (sort users (lambda (a b)
+                                       (string<= (user-name a)
+                                                 (user-name b)))))
+           (listbox-elements
+            (map
+             (lambda (user)
+               `((key . ,(append-entry-to-listbox listbox
+                                                  (user-name user)))
+                 (user . ,user)))
+             sorted-users))
+           (form (make-form)))
+
+
+      (add-form-to-grid grid form #t)
+      (make-wrapped-grid-window grid title)
+      (if (null? users)
+          (set-current-component form add-button)
+          (set-current-component form ok-button))
+
+      (receive (exit-reason argument)
+          (run-form form)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (when (eq? exit-reason 'exit-component)
+              (cond
+               ((components=? argument add-button)
+                (run (cons (run-user-add-page) users)))
+               ((components=? argument del-button)
+                (let* ((current-user-key (current-listbox-entry listbox))
+                       (users
+                        (map (cut assoc-ref <> 'user)
+                             (remove (lambda (element)
+                                       (equal? (assoc-ref element 'key)
+                                               current-user-key))
+                                     listbox-elements))))
+                  (run users)))
+               ((components=? argument ok-button)
+                (when (null? users)
+                  (run-error-page (G_ "Please create at least one user.")
+                                  (G_ "No user"))
+                  (run users))
+                users))))
+          (lambda ()
+            (destroy-form-and-pop form))))))
+  (run '()))
diff --git a/gnu/installer/newt/utils.scm b/gnu/installer/newt/utils.scm
new file mode 100644
index 0000000000..1c2ce4e628
--- /dev/null
+++ b/gnu/installer/newt/utils.scm
@@ -0,0 +1,43 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt utils)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (screen-columns
+            screen-rows
+
+            destroy-form-and-pop
+            set-screen-size!))
+
+;; Number of columns and rows of the terminal.
+(define screen-columns (make-parameter 0))
+(define screen-rows    (make-parameter 0))
+
+(define (destroy-form-and-pop form)
+  "Destory the given FORM and pop the current window."
+  (destroy-form form)
+  (pop-window))
+
+(define (set-screen-size!)
+  "Set the parameters 'screen-columns' and 'screen-rows' to the number of
+columns and rows respectively of the current terminal."
+  (receive (columns rows)
+      (screen-size)
+    (screen-columns columns)
+    (screen-rows rows)))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
new file mode 100644
index 0000000000..eec98e291a
--- /dev/null
+++ b/gnu/installer/newt/welcome.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+
+;;;
+;;; 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 installer newt welcome)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix build syscalls)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (run-welcome-page))
+
+;; Expected width and height for the logo.
+(define logo-width (make-parameter 43))
+(define logo-height (make-parameter 19))
+
+(define info-textbox-width (make-parameter 70))
+(define options-listbox-height (make-parameter 5))
+
+(define* (run-menu-page title info-text logo
+                        #:key
+                        listbox-items
+                        listbox-item->text)
+  "Run a page with the given TITLE, to ask the user to choose between
+LISTBOX-ITEMS displayed in a listbox. The listbox items are converted to text
+using LISTBOX-ITEM->TEXT procedure. Display the textual LOGO in the center of
+the page. Contrary to other pages, we cannot resort to grid layouts, because
+we want this page to occupy all the screen space available."
+  (define (fill-listbox listbox items)
+    (map (lambda (item)
+           (let* ((text (listbox-item->text item))
+                  (key (append-entry-to-listbox listbox text)))
+             (cons key item)))
+         items))
+
+  (let* ((logo-textbox
+          (make-textbox -1 -1 (logo-width) (logo-height) 0))
+         (info-textbox
+          (make-reflowed-textbox -1 -1
+                                 info-text
+                                 (info-textbox-width)))
+         (options-listbox
+          (make-listbox -1 -1
+                        (options-listbox-height)
+                        (logior FLAG-BORDER FLAG-RETURNEXIT)))
+         (keys (fill-listbox options-listbox listbox-items))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT logo-textbox
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT options-listbox))
+         (form (make-form)))
+
+    (set-textbox-text logo-textbox (read-all logo))
+
+    (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 ()
+          (when (eq? exit-reason 'exit-component)
+            (cond
+             ((components=? argument options-listbox)
+              (let* ((entry (current-listbox-entry options-listbox))
+                     (item (assoc-ref keys entry)))
+                (match item
+                  ((text . proc)
+                   (proc))))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
+(define (run-welcome-page logo)
+  "Run a welcome page with the given textual LOGO displayed at the center of
+the page. Ask the user to choose between manual installation, graphical
+installation and reboot."
+  (run-menu-page
+   (G_ "GNU GuixSD install")
+   (G_ "Welcome to GNU GuixSD 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.")
+   logo
+   #:listbox-items
+   `((,(G_ "Graphical install using a terminal based interface")
+      .
+      ,(const #t))
+     (,(G_ "Install using the shell based process")
+      .
+      ,(lambda ()
+         ;; Switch to TTY3, where a root shell is available for shell based
+         ;; install. The other root TTY's would have been ok too.
+         (system* "chvt" "3")
+         (run-welcome-page logo)))
+     (,(G_ "Reboot")
+      .
+      ,(lambda ()
+         (newt-finish)
+         (reboot))))
+   #:listbox-item->text car))
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
new file mode 100644
index 0000000000..59e40e327e
--- /dev/null
+++ b/gnu/installer/newt/wifi.scm
@@ -0,0 +1,243 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer newt wifi)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-wifi-page))
+
+;; This record associates a connman service to its key the listbox.
+(define-record-type* <service-item>
+  service-item make-service-item
+  service-item?
+  (service   service-item-service) ; connman <service>
+  (key       service-item-key)) ; newt listbox-key
+
+(define (strength->string strength)
+  "Convert STRENGTH as an integer percentage into a text printable strength
+bar using unicode characters. Taken from NetworkManager's
+nmc_wifi_strength_bars."
+  (let ((quarter #\x2582)
+        (half #\x2584)
+        (three-quarter #\x2586)
+        (full #\x2588))
+    (cond
+     ((> strength 80)
+      ;; ▂▄▆█
+      (string quarter half three-quarter full))
+     ((> strength 55)
+      ;; ▂▄▆_
+      (string quarter half three-quarter #\_))
+     ((> strength 30)
+      ;; ▂▄__
+      (string quarter half #\_ #\_))
+     ((> strength 5)
+      ;; ▂___
+      (string quarter #\_ #\_ #\_))
+     (else
+      ;; ____
+      (string quarter #\_ #\_ #\_ #\_)))))
+
+(define (force-wifi-scan)
+  "Force a wifi scan. Raise a condition if no wifi technology is available."
+  (let* ((technologies (connman-technologies))
+         (wifi-technology
+          (find (lambda (technology)
+                  (string=? (technology-type technology) "wifi"))
+                technologies)))
+    (if wifi-technology
+        (connman-scan-technology wifi-technology)
+        (raise (condition
+                (&message
+                 (message (G_ "Unable to find a wifi technology"))))))))
+
+(define (draw-scanning-page)
+  "Draw a page to indicate a wifi scan in in progress."
+  (draw-info-page (G_ "Scanning wifi for available networks, please wait.")
+                  (G_ "Scan in progress")))
+
+(define (run-wifi-password-page)
+  "Run a page prompting user for a password and return it."
+  (run-input-page (G_ "Please enter the wifi password.")
+                  (G_ "Password required")))
+
+(define (run-wrong-password-page service-name)
+  "Run a page to inform user of a wrong password input."
+  (run-error-page
+   (format #f (G_ "The password you entered for ~a is incorrect.")
+           service-name)
+   (G_ "Wrong password")))
+
+(define (run-unknown-error-page service-name)
+  "Run a page to inform user that a connection error happened."
+  (run-error-page
+   (format #f
+           (G_ "An error occured while trying to connect to ~a, please retry.")
+           service-name)
+   (G_ "Connection error")))
+
+(define (password-callback)
+  (run-wifi-password-page))
+
+(define (connect-wifi-service listbox service-items)
+  "Connect to the wifi service selected in LISTBOX. SERVICE-ITEMS is the list
+of <service-item> records present in LISTBOX."
+  (let* ((listbox-key (current-listbox-entry listbox))
+         (item (find (lambda (item)
+                       (eq? (service-item-key item) listbox-key))
+                     service-items))
+         (service (service-item-service item))
+         (service-name (service-name service))
+         (form (draw-connecting-page service-name)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (guard (c ((connman-password-error? c)
+                   (run-wrong-password-page service-name)
+                   #f)
+                  ((connman-already-connected-error? c)
+                   #t)
+                  ((connman-connection-error? c)
+                   (run-unknown-error-page service-name)
+                   #f))
+          (connman-connect-with-auth service password-callback)))
+      (lambda ()
+        (destroy-form-and-pop form)))))
+
+(define (run-wifi-scan-page)
+  "Force a wifi scan and draw a page during the operation."
+  (let ((form (draw-scanning-page)))
+    (force-wifi-scan)
+    (destroy-form-and-pop form)))
+
+(define (wifi-services)
+  "Return all the connman services of wifi type."
+  (let ((services (connman-services)))
+    (filter (lambda (service)
+              (and (string=? (service-type service) "wifi")
+                   (not (string-null? (service-name service)))))
+            services)))
+
+(define* (fill-wifi-services listbox wifi-services)
+  "Append all the services in WIFI-SERVICES to the given LISTBOX."
+  (clear-listbox listbox)
+  (map (lambda (service)
+         (let* ((text (service->text service))
+                (key (append-entry-to-listbox listbox text)))
+           (service-item
+            (service service)
+            (key key))))
+       wifi-services))
+
+;; Maximum length of a wifi service name.
+(define service-name-max-length (make-parameter 20))
+
+;; Heigth of the listbox displaying wifi services.
+(define wifi-listbox-heigth (make-parameter 20))
+
+;; Information textbox width.
+(define info-textbox-width (make-parameter 40))
+
+(define (service->text service)
+  "Return a string composed of the name and the strength of the given
+SERVICE. A '*' preceding the service name indicates that it is connected."
+  (let* ((name (service-name service))
+         (padded-name (string-pad-right name
+                                        (service-name-max-length)))
+         (strength (service-strength service))
+         (strength-string (strength->string strength))
+         (state (service-state service))
+         (connected? (or (string=? state "online")
+                         (string=? state "ready"))))
+    (format #f "~c ~a ~a~%"
+            (if connected? #\* #\ )
+            padded-name
+            strength-string)))
+
+(define (run-wifi-page)
+  "Run a page displaying available wifi networks in a listbox. Connect to the
+network when the corresponding listbox entry is selected. A button allow to
+force a wifi scan."
+  (let* ((listbox (make-listbox
+                   -1 -1
+                   (wifi-listbox-heigth)
+                   (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT)))
+         (form (make-form))
+         (buttons-grid (make-grid 1 1))
+         (middle-grid (make-grid 2 1))
+         (info-text (G_ "Please select a wifi network."))
+         (info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 (info-textbox-width)
+                                 #:flags FLAG-BORDER))
+         (exit-button (make-button -1 -1 (G_ "Exit")))
+         (scan-button (make-button -1 -1 (G_ "Scan")))
+         (services (wifi-services))
+         (service-items '()))
+
+    (if (null? services)
+        (append-entry-to-listbox listbox (G_ "No wifi detected"))
+        (set! service-items (fill-wifi-services listbox services)))
+
+    (set-grid-field middle-grid 0 0 GRID-ELEMENT-COMPONENT listbox)
+    (set-grid-field middle-grid 1 0 GRID-ELEMENT-COMPONENT scan-button
+                    #:anchor ANCHOR-TOP
+                    #:pad-left 2)
+    (set-grid-field buttons-grid 0 0 GRID-ELEMENT-COMPONENT exit-button)
+
+    (add-components-to-form form
+                            info-textbox
+                            listbox scan-button
+                            exit-button)
+    (make-wrapped-grid-window
+     (basic-window-grid info-textbox middle-grid buttons-grid)
+     (G_ "Wifi"))
+
+    (receive (exit-reason argument)
+        (run-form form)
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (when (eq? exit-reason 'exit-component)
+            (cond
+             ((components=? argument scan-button)
+              (run-wifi-scan-page)
+              (run-wifi-page))
+             ((components=? argument exit-button)
+              (raise
+               (condition
+                (&installer-step-abort))))
+             ((components=? argument listbox)
+              (let ((result (connect-wifi-service listbox service-items)))
+                (unless result
+                  (run-wifi-page)))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
new file mode 100644
index 0000000000..187311e633
--- /dev/null
+++ b/gnu/installer/parted.scm
@@ -0,0 +1,1312 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer parted)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu system uuid)
+  #:use-module ((gnu build file-systems)
+                #:select (read-partition-uuid
+                          read-luks-partition-uuid))
+  #:use-module (guix build syscalls)
+  #:use-module (guix build utils)
+  #:use-module (guix records)
+  #:use-module (guix utils)
+  #:use-module (guix i18n)
+  #:use-module (parted)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (<user-partition>
+            user-partition
+            make-user-partition
+            user-partition?
+            user-partition-name
+            user-partition-type
+            user-partition-file-name
+            user-partition-disk-file-name
+            user-partition-crypt-label
+            user-partition-crypt-password
+            user-partition-fs-type
+            user-partition-bootable?
+            user-partition-esp?
+            user-partition-bios-grub?
+            user-partition-size
+            user-partition-start
+            user-partition-end
+            user-partition-mount-point
+            user-partition-need-formatting?
+            user-partition-parted-object
+
+            find-esp-partition
+            data-partition?
+            metadata-partition?
+            freespace-partition?
+            small-freespace-partition?
+            normal-partition?
+            extended-partition?
+            logical-partition?
+            esp-partition?
+            boot-partition?
+            default-esp-mount-point
+
+            with-delay-device-in-use?
+            force-device-sync
+            non-install-devices
+            partition-user-type
+            user-fs-type-name
+            partition-filesystem-user-type
+            partition-get-flags
+            partition->user-partition
+            create-special-user-partitions
+            find-user-partition-by-parted-object
+
+            device-description
+            partition-end-formatted
+            partition-print-number
+            partition-description
+            partitions-descriptions
+            user-partition-description
+
+            &max-primary-exceeded
+            max-primary-exceeded?
+            &extended-creation-error
+            extended-creation-error?
+            &logical-creation-error
+            logical-creation-error?
+
+            can-create-partition?
+            mklabel
+            mkpart
+            rmpart
+
+            create-adjacent-partitions
+            auto-partition
+
+            &no-root-mount-point
+            no-root-mount-point?
+
+            check-user-partitions
+            set-user-partitions-file-name
+            format-user-partitions
+            mount-user-partitions
+            umount-user-partitions
+            with-mounted-partitions
+            user-partitions->file-systems
+            user-partitions->configuration
+
+            init-parted
+            free-parted))
+
+
+;;;
+;;; Partition record.
+;;;
+
+(define-record-type* <user-partition>
+  user-partition make-user-partition
+  user-partition?
+  (name                 user-partition-name ;string
+                        (default #f))
+  (type                 user-partition-type
+                        (default 'normal)) ; 'normal | 'logical | 'extended
+  (file-name            user-partition-file-name
+                        (default #f))
+  (disk-file-name       user-partition-disk-file-name
+                        (default #f))
+  (crypt-label          user-partition-crypt-label
+                        (default #f))
+  (crypt-password       user-partition-crypt-password
+                        (default #f))
+  (fs-type              user-partition-fs-type
+                        (default 'ext4))
+  (bootable?            user-partition-bootable?
+                        (default #f))
+  (esp?                 user-partition-esp?
+                        (default #f))
+  (bios-grub?           user-partition-bios-grub?
+                        (default #f))
+  (size                 user-partition-size
+                        (default #f))
+  (start                user-partition-start ;start as string (e.g. '11MB')
+                        (default #f))
+  (end                  user-partition-end ;same as start
+                        (default #f))
+  (mount-point          user-partition-mount-point ;string
+                        (default #f))
+  (need-formatting?     user-partition-need-formatting? ; boolean
+                        (default #f))
+  (parted-object        user-partition-parted-object ; <partition> from parted
+                        (default #f)))
+
+
+;;
+;; Utilities.
+;;
+
+(define (find-esp-partition partitions)
+  "Find and return the ESP partition among PARTITIONS."
+  (find esp-partition? partitions))
+
+(define (data-partition? partition)
+  "Return #t if PARTITION is a partition dedicated to data (by opposition to
+freespace, metadata and protected partition types), return #f otherwise."
+  (let ((type (partition-type partition)))
+    (not (any (lambda (flag)
+                (member flag type))
+              '(free-space metadata protected)))))
+
+(define (metadata-partition? partition)
+  "Return #t if PARTITION is a metadata partition, #f otherwise."
+  (let ((type (partition-type partition)))
+    (member 'metadata type)))
+
+(define (freespace-partition? partition)
+  "Return #t if PARTITION is a free-space partition, #f otherwise."
+  (let ((type (partition-type partition)))
+    (member 'free-space type)))
+
+(define* (small-freespace-partition? device
+                                     partition
+                                     #:key (max-size MEBIBYTE-SIZE))
+  "Return #t is PARTITION is a free-space partition with less a size strictly
+inferior to MAX-SIZE, #f otherwise."
+  (let ((size (partition-length partition))
+        (max-sector-size (/ max-size
+                            (device-sector-size device))))
+    (< size max-sector-size)))
+
+(define (normal-partition? partition)
+  "return #t if partition is a normal partition, #f otherwise."
+  (let ((type (partition-type partition)))
+    (member 'normal type)))
+
+(define (extended-partition? partition)
+  "return #t if partition is an extended partition, #f otherwise."
+  (let ((type (partition-type partition)))
+    (member 'extended type)))
+
+(define (logical-partition? partition)
+  "Return #t if PARTITION is a logical partition, #f otherwise."
+  (let ((type (partition-type partition)))
+    (member 'logical type)))
+
+(define (partition-user-type partition)
+  "Return the type of PARTITION, to be stored in the TYPE field of
+<user-partition> record. It can be 'normal, 'extended or 'logical."
+  (cond ((normal-partition? partition)
+         'normal)
+        ((extended-partition? partition)
+         'extended)
+        ((logical-partition? partition)
+         'logical)
+        (else #f)))
+
+(define (esp-partition? partition)
+  "Return #t if partition has the ESP flag, return #f otherwise."
+  (let* ((disk (partition-disk partition))
+         (disk-type (disk-disk-type disk))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED)))
+    (and (data-partition? partition)
+         (not has-extended?)
+         (partition-is-flag-available? partition PARTITION-FLAG-ESP)
+         (partition-get-flag partition PARTITION-FLAG-ESP))))
+
+(define (boot-partition? partition)
+  "Return #t if partition has the boot flag, return #f otherwise."
+  (and (data-partition? partition)
+       (partition-is-flag-available? partition PARTITION-FLAG-BOOT)
+       (partition-get-flag partition PARTITION-FLAG-BOOT)))
+
+
+;; The default mount point for ESP partitions.
+(define default-esp-mount-point
+  (make-parameter "/boot/efi"))
+
+(define (efi-installation?)
+  "Return #t if an EFI installation should be performed, #f otherwise."
+  (file-exists? "/sys/firmware/efi"))
+
+(define (user-fs-type-name fs-type)
+  "Return the name of FS-TYPE as specified by libparted."
+  (case fs-type
+    ((ext4)  "ext4")
+    ((btrfs) "btrfs")
+    ((fat32) "fat32")
+    ((swap)  "linux-swap")))
+
+(define (user-fs-type->mount-type fs-type)
+  "Return the mount type of FS-TYPE."
+  (case fs-type
+    ((ext4)  "ext4")
+    ((btrfs) "btrfs")
+    ((fat32) "vfat")))
+
+(define (partition-filesystem-user-type partition)
+  "Return the filesystem type of PARTITION, to be stored in the FS-TYPE field
+of <user-partition> record."
+  (let ((fs-type (partition-fs-type partition)))
+    (and fs-type
+         (let ((name (filesystem-type-name fs-type)))
+           (cond
+            ((string=? name "ext4") 'ext4)
+            ((string=? name "btrfs") 'btrfs)
+            ((string=? name "fat32") 'fat32)
+            ((or (string=? name "swsusp")
+                 (string=? name "linux-swap(v0)")
+                 (string=? name "linux-swap(v1)"))
+             'swap)
+            (else
+             (error (format #f "Unhandled ~a fs-type~%" name))))))))
+
+(define (partition-get-flags partition)
+  "Return the list of flags supported by the given PARTITION."
+  (filter-map (lambda (flag)
+                (and (partition-get-flag partition flag)
+                     flag))
+              (partition-flags partition)))
+
+(define (partition->user-partition partition)
+  "Convert PARTITION into a <user-partition> record and return it."
+  (let* ((disk (partition-disk partition))
+         (device (disk-device disk))
+         (disk-type (disk-disk-type disk))
+         (has-name? (disk-type-check-feature
+                     disk-type
+                     DISK-TYPE-FEATURE-PARTITION-NAME))
+         (name (and has-name?
+                    (data-partition? partition)
+                    (partition-get-name partition))))
+    (user-partition
+     (name (and (and name
+                     (not (string=? name "")))
+                name))
+     (type (or (partition-user-type partition)
+               'normal))
+     (file-name (partition-get-path partition))
+     (disk-file-name (device-path device))
+     (fs-type (or (partition-filesystem-user-type partition)
+                  'ext4))
+     (mount-point (and (esp-partition? partition)
+                       (default-esp-mount-point)))
+     (bootable? (boot-partition? partition))
+     (esp? (esp-partition? partition))
+     (parted-object partition))))
+
+(define (create-special-user-partitions partitions)
+  "Return a list with a <user-partition> record describing the ESP partition
+found in PARTITIONS, if any."
+  (filter-map (lambda (partition)
+                (and (esp-partition? partition)
+                     (partition->user-partition partition)))
+              partitions))
+
+(define (find-user-partition-by-parted-object user-partitions
+                                              partition)
+  "Find and return the <user-partition> record in USER-PARTITIONS list which
+PARTED-OBJECT field equals PARTITION, return #f if not found."
+  (find (lambda (user-partition)
+          (equal? (user-partition-parted-object user-partition)
+                  partition))
+        user-partitions))
+
+
+;;
+;; Devices
+;;
+
+(define (with-delay-device-in-use? file-name)
+  "Call DEVICE-IN-USE? with a few retries, as the first re-read will often
+fail. See rereadpt function in wipefs.c of util-linux for an explanation."
+  ;; Kernel always return EINVAL for BLKRRPART on loopdevices.
+  (and (not (string-match "/dev/loop*" file-name))
+       (let loop ((try 4))
+         (usleep 250000)
+         (let ((in-use? (device-in-use? file-name)))
+           (if (and in-use? (> try 0))
+               (loop (- try 1))
+               in-use?)))))
+
+(define* (force-device-sync device)
+  "Force a flushing of the given DEVICE."
+  (device-open device)
+  (device-sync device)
+  (device-close device))
+
+(define (non-install-devices)
+  "Return all the available devices, except the busy one, allegedly the
+install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
+mounted. The install image uses an overlayfs so the install device does not
+appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE?
+from (guix build syscalls) module, who will try to re-read the device's
+partition table to determine whether or not it is already used (like sfdisk
+from util-linux)."
+  (remove (lambda (device)
+            (let ((file-name (device-path device)))
+              (or (device-is-busy? device)
+                  (with-delay-device-in-use? file-name))))
+          (devices)))
+
+
+;;
+;; Disk and partition printing.
+;;
+
+(define* (device-description device #:optional disk)
+  "Return a string describing the given DEVICE."
+  (let* ((type (device-type device))
+         (file-name (device-path device))
+         (model (device-model device))
+         (type-str (device-type->string type))
+         (disk-type (if disk
+                        (disk-disk-type disk)
+                        (disk-probe device)))
+         (length (device-length device))
+         (sector-size (device-sector-size device))
+         (end (unit-format-custom-byte device
+                                       (* length sector-size)
+                                       UNIT-GIGABYTE)))
+    (string-join
+     `(,@(if (string=? model "")
+             `(,type-str)
+             `(,model ,(string-append "(" type-str ")")))
+       ,file-name
+       ,end
+       ,@(if disk-type
+             `(,(disk-type-name disk-type))
+             '()))
+     " ")))
+
+(define (partition-end-formatted device partition)
+  "Return as a string the end of PARTITION with the relevant unit."
+  (unit-format-byte
+   device
+   (-
+    (* (+ (partition-end partition) 1)
+       (device-sector-size device))
+    1)))
+
+(define (partition-print-number partition)
+  "Convert the given partition NUMBER to string."
+  (let ((number (partition-number partition)))
+    (number->string number)))
+
+(define (partition-description partition user-partition)
+  "Return a string describing the given PARTITION, located on the DISK of
+DEVICE."
+
+  (define (partition-print-type partition)
+    "Return the type of PARTITION as a string."
+    (if (freespace-partition? partition)
+        (G_ "Free space")
+        (let ((type (partition-type partition)))
+          (match type
+            ((type-symbol)
+             (symbol->string type-symbol))))))
+
+  (define (partition-print-flags partition)
+    "Return the flags of PARTITION as a string of comma separated flags."
+    (string-join
+     (filter-map
+      (lambda (flag)
+        (and (partition-get-flag partition flag)
+             (partition-flag-get-name flag)))
+      (partition-flags partition))
+     ","))
+
+  (define (maybe-string-pad string length)
+    "Returned a string formatted by padding STRING of LENGTH characters to the
+right. If STRING is #f use an empty string."
+    (if (and string (not (string=? string "")))
+        (string-pad-right string length)
+        ""))
+
+  (let* ((disk (partition-disk partition))
+         (device (disk-device disk))
+         (disk-type (disk-disk-type disk))
+         (has-name? (disk-type-check-feature
+                     disk-type
+                     DISK-TYPE-FEATURE-PARTITION-NAME))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED))
+         (part-type (partition-print-type partition))
+         (number (and (not (freespace-partition? partition))
+                      (partition-print-number partition)))
+         (name (and has-name?
+                    (if (freespace-partition? partition)
+                        (G_ "Free space")
+                        (partition-get-name partition))))
+         (start (unit-format device
+                             (partition-start partition)))
+         (end (partition-end-formatted device partition))
+         (size (unit-format device (partition-length partition)))
+         (fs-type (partition-fs-type partition))
+         (fs-type-name (and fs-type
+                            (filesystem-type-name fs-type)))
+         (crypt-label (and user-partition
+                           (user-partition-crypt-label user-partition)))
+         (flags (and (not (freespace-partition? partition))
+                     (partition-print-flags partition)))
+         (mount-point (and user-partition
+                           (user-partition-mount-point user-partition))))
+    `(,(or number "")
+      ,@(if has-extended?
+            (list part-type)
+            '())
+      ,size
+      ,(or fs-type-name "")
+      ,(or flags "")
+      ,(or mount-point "")
+      ,(or crypt-label "")
+      ,(maybe-string-pad name 30))))
+
+(define (partitions-descriptions partitions user-partitions)
+  "Return a list of strings describing all the partitions found on
+DEVICE. METADATA partitions are not described. The strings are padded to the
+right so that they can be displayed as a table."
+
+  (define (max-length-column lists column-index)
+    "Return the maximum length of the string at position COLUMN-INDEX in the
+list of string lists LISTS."
+    (apply max
+           (map (lambda (list)
+                  (string-length
+                   (list-ref list column-index)))
+                lists)))
+
+  (define (pad-descriptions descriptions)
+    "Return a padded version of the list of string lists DESCRIPTIONS. The
+strings are padded to the length of the longer string in a same column, as
+determined by MAX-LENGTH-COLUMN procedure."
+    (let* ((description-length (length (car descriptions)))
+           (paddings (map (lambda (index)
+                            (max-length-column descriptions index))
+                          (iota description-length))))
+      (map (lambda (description)
+             (map string-pad-right description paddings))
+           descriptions)))
+
+  (let* ((descriptions
+          (map
+           (lambda (partition)
+             (let ((user-partition
+                    (find-user-partition-by-parted-object user-partitions
+                                                          partition)))
+               (partition-description partition user-partition)))
+           partitions))
+         (padded-descriptions (if (null? partitions)
+                                  '()
+                                  (pad-descriptions descriptions))))
+    (map (cut string-join <> " ") padded-descriptions)))
+
+(define (user-partition-description user-partition)
+  "Return a string describing the given USER-PARTITION record."
+  (let* ((partition (user-partition-parted-object user-partition))
+         (disk (partition-disk partition))
+         (disk-type (disk-disk-type disk))
+         (device (disk-device disk))
+         (has-name? (disk-type-check-feature
+                     disk-type
+                     DISK-TYPE-FEATURE-PARTITION-NAME))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED))
+         (name (user-partition-name user-partition))
+         (type (user-partition-type user-partition))
+         (type-name (symbol->string type))
+         (fs-type (user-partition-fs-type user-partition))
+         (fs-type-name (user-fs-type-name fs-type))
+         (bootable? (user-partition-bootable? user-partition))
+         (esp? (user-partition-esp? user-partition))
+         (need-formatting? (user-partition-need-formatting? user-partition))
+         (crypt-label (user-partition-crypt-label user-partition))
+         (size (user-partition-size user-partition))
+         (mount-point (user-partition-mount-point user-partition)))
+    `(,@(if has-name?
+            `((name . ,(string-append "Name: " (or name "None"))))
+            '())
+      ,@(if (and has-extended?
+                 (freespace-partition? partition)
+                 (not (eq? type 'logical)))
+            `((type . ,(string-append "Type: " type-name)))
+            '())
+      ,@(if (eq? type 'extended)
+            '()
+            `((fs-type . ,(string-append "Filesystem type: " fs-type-name))))
+      ,@(if (or (eq? type 'extended)
+                (eq? fs-type 'swap)
+                (not has-extended?))
+            '()
+            `((bootable . ,(string-append "Bootable flag: "
+                                          (if bootable? "On" "Off")))))
+      ,@(if (and (not has-extended?)
+                 (not (eq? fs-type 'swap)))
+            `((esp? . ,(string-append "ESP flag: "
+                                      (if esp? "On" "Off"))))
+            '())
+      ,@(if (freespace-partition? partition)
+            (let ((size-formatted
+                   (or size (unit-format device
+                                         (partition-length partition)))))
+              `((size . ,(string-append "Size : " size-formatted))))
+            '())
+      ,@(if (or (eq? type 'extended)
+                (eq? fs-type 'swap))
+            '()
+            `((crypt-label
+               . ,(string-append
+                   "Encryption: "
+                   (if crypt-label
+                       (format #f "Yes (label ~a)" crypt-label)
+                       "No")))))
+      ,@(if (or (freespace-partition? partition)
+                (eq? fs-type 'swap))
+            '()
+            `((need-formatting?
+               . ,(string-append "Format the partition? : "
+                                 (if need-formatting? "Yes" "No")))))
+      ,@(if (or (eq? type 'extended)
+                (eq? fs-type 'swap))
+            '()
+            `((mount-point
+               . ,(string-append "Mount point : "
+                                 (or mount-point
+                                     (and esp? (default-esp-mount-point))
+                                     "None"))))))))
+
+
+;;
+;; Partition table creation.
+;;
+
+(define (mklabel device type-name)
+  "Create a partition table on DEVICE. TYPE-NAME is the type of the partition
+table, \"msdos\" or \"gpt\"."
+  (let ((type (disk-type-get type-name)))
+    (disk-new-fresh device type)))
+
+
+;;
+;; Partition creation.
+;;
+
+;; The maximum count of primary partitions is exceeded.
+(define-condition-type &max-primary-exceeded &condition
+  max-primary-exceeded?)
+
+;; It is not possible to create an extended partition.
+(define-condition-type &extended-creation-error &condition
+  extended-creation-error?)
+
+;; It is not possible to create a logical partition.
+(define-condition-type &logical-creation-error &condition
+  logical-creation-error?)
+
+(define (can-create-primary? disk)
+  "Return #t if it is possible to create a primary partition on DISK, return
+#f otherwise."
+  (let ((max-primary (disk-get-max-primary-partition-count disk)))
+    (find (lambda (number)
+            (not (disk-get-partition disk number)))
+          (iota max-primary 1))))
+
+(define (can-create-extended? disk)
+  "Return #t if it is possible to create an extended partition on DISK, return
+#f otherwise."
+  (let* ((disk-type (disk-disk-type disk))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED)))
+    (and (can-create-primary? disk)
+         has-extended?
+         (not (disk-extended-partition disk)))))
+
+(define (can-create-logical? disk)
+  "Return #t is it is possible to create a logical partition on DISK, return
+#f otherwise."
+  (let* ((disk-type (disk-disk-type disk))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED)))
+    (and has-extended?
+         (disk-extended-partition disk))))
+
+(define (can-create-partition? user-part)
+  "Return #t if it is possible to create the given USER-PART record, return #f
+otherwise."
+  (let* ((type (user-partition-type user-part))
+         (partition (user-partition-parted-object user-part))
+         (disk (partition-disk partition)))
+    (case type
+      ((normal)
+       (or (can-create-primary? disk)
+           (raise
+            (condition (&max-primary-exceeded)))))
+      ((extended)
+       (or (can-create-extended? disk)
+           (raise
+            (condition (&extended-creation-error)))))
+      ((logical)
+       (or (can-create-logical? disk)
+           (raise
+            (condition (&logical-creation-error))))))))
+
+(define* (mkpart disk user-partition
+                 #:key (previous-partition #f))
+  "Create the given USER-PARTITION on DISK. The PREVIOUS-PARTITION argument as
+to be set to the partition preceeding USER-PARTITION if any."
+
+  (define (parse-start-end start end)
+    "Parse start and end strings as positions on DEVICE expressed with a unit,
+like '100GB' or '12.2KiB'. Return a list of 4 elements, the start sector, its
+range (1 unit large area centered on start sector), the end sector and its
+range."
+    (let ((device (disk-device disk)))
+      (call-with-values
+          (lambda ()
+            (unit-parse start device))
+        (lambda (start-sector start-range)
+          (call-with-values
+              (lambda ()
+                (unit-parse end device))
+            (lambda (end-sector end-range)
+              (list start-sector start-range
+                    end-sector end-range)))))))
+
+  (define* (extend-ranges! start-range end-range
+                           #:key (offset 0))
+    "Try to extend START-RANGE by 1 MEBIBYTE to the right and END-RANGE by 1
+MEBIBYTE to the left. This way, if the disk is aligned on 2048 sectors of
+512KB (like frequently), we will have a chance for the
+'optimal-align-constraint' to succeed. Do not extend ranges if that would
+cause them to cross."
+    (let* ((device (disk-device disk))
+           (start-range-end (geometry-end start-range))
+           (end-range-start (geometry-start end-range))
+           (mebibyte-sector-size (/ MEBIBYTE-SIZE
+                                    (device-sector-size device)))
+           (new-start-range-end
+            (+ start-range-end mebibyte-sector-size offset))
+           (new-end-range-start
+            (- end-range-start mebibyte-sector-size offset)))
+      (when (< new-start-range-end new-end-range-start)
+        (geometry-set-end start-range new-start-range-end)
+        (geometry-set-start end-range new-end-range-start))))
+
+  (match (parse-start-end (user-partition-start user-partition)
+                          (user-partition-end user-partition))
+    ((start-sector start-range end-sector end-range)
+     (let* ((prev-end (if previous-partition
+                          (partition-end previous-partition)
+                          0))
+            (start-distance (- start-sector prev-end))
+            (type (user-partition-type user-partition))
+            ;; There should be at least 2 unallocated sectors in front of each
+            ;; logical partition, otherwise parted will fail badly:
+            ;; https://gparted.org/h2-fix-msdos-pt.php#apply-action-fail.
+            (start-offset (if previous-partition
+                              (- 3 start-distance)
+                              0))
+            (start-sector* (if (and (eq? type 'logical)
+                                    (< start-distance 3))
+                               (+ start-sector start-offset)
+                               start-sector)))
+       ;; This is a hackery but parted almost always fails to create optimally
+       ;; aligned partitions (unless specifiying percentages) because, the
+       ;; default range of 1MB centered on the start sector is not enough when
+       ;; the optimal alignment is 2048 sectors of 512KB.
+       (extend-ranges! start-range end-range #:offset start-offset)
+
+       (let* ((device (disk-device disk))
+              (disk-type (disk-disk-type disk))
+              (length (device-length device))
+              (name (user-partition-name user-partition))
+              (filesystem-type
+               (filesystem-type-get
+                (user-fs-type-name
+                 (user-partition-fs-type user-partition))))
+              (flags `(,@(if (user-partition-bootable? user-partition)
+                             `(,PARTITION-FLAG-BOOT)
+                             '())
+                       ,@(if (user-partition-esp? user-partition)
+                             `(,PARTITION-FLAG-ESP)
+                             '())
+                       ,@(if (user-partition-bios-grub? user-partition)
+                             `(,PARTITION-FLAG-BIOS-GRUB)
+                             '())))
+              (has-name? (disk-type-check-feature
+                          disk-type
+                          DISK-TYPE-FEATURE-PARTITION-NAME))
+              (partition-type (partition-type->int type))
+              (partition (partition-new disk
+                                        #:type partition-type
+                                        #:filesystem-type filesystem-type
+                                        #:start start-sector*
+                                        #:end end-sector))
+              (user-constraint (constraint-new
+                                #:start-align 'any
+                                #:end-align 'any
+                                #:start-range start-range
+                                #:end-range end-range
+                                #:min-size 1
+                                #:max-size length))
+              (dev-constraint
+               (device-get-optimal-aligned-constraint device))
+              (final-constraint (constraint-intersect user-constraint
+                                                      dev-constraint))
+              (no-constraint (constraint-any device))
+              ;; Try to create a partition with an optimal alignment
+              ;; constraint. If it fails, fallback to creating a partition with
+              ;; no specific constraint.
+              (partition-ok?
+               (or (disk-add-partition disk partition final-constraint)
+                   (disk-add-partition disk partition no-constraint))))
+         ;; Set the partition name if supported.
+         (when (and partition-ok? has-name? name)
+           (partition-set-name partition name))
+
+         ;; Set flags is required.
+         (for-each (lambda (flag)
+                     (and (partition-is-flag-available? partition flag)
+                          (partition-set-flag partition flag 1)))
+                   flags)
+
+         (and partition-ok?
+              (partition-set-system partition filesystem-type)
+              partition))))))
+
+
+;;
+;; Partition destruction.
+;;
+
+(define (rmpart disk number)
+  "Remove the partition with the given NUMBER on DISK."
+  (let ((partition (disk-get-partition disk number)))
+    (disk-remove-partition disk partition)))
+
+
+;;
+;; Auto partitionning.
+;;
+
+(define* (create-adjacent-partitions disk partitions
+                                     #:key (last-partition-end 0))
+  "Create the given PARTITIONS on DISK. LAST-PARTITION-END is the sector from
+which we want to start creating partitions. The START and END of each created
+partition are computed from its SIZE value and the position of the last
+partition."
+  (let ((device (disk-device disk)))
+    (let loop ((partitions partitions)
+               (remaining-space (- (device-length device)
+                                   last-partition-end))
+               (start last-partition-end))
+      (match partitions
+        (() '())
+        ((partition . rest)
+         (let* ((size (user-partition-size partition))
+                (percentage-size (and (string? size)
+                                      (read-percentage size)))
+                (sector-size (device-sector-size device))
+                (partition-size (if percentage-size
+                                    (exact->inexact
+                                     (* (/ percentage-size 100)
+                                        remaining-space))
+                                    size))
+                (end-partition (min (- (device-length device) 1)
+                                    (nearest-exact-integer
+                                     (+ start partition-size 1))))
+                (name (user-partition-name partition))
+                (type (user-partition-type partition))
+                (fs-type (user-partition-fs-type partition))
+                (start-formatted (unit-format-custom device
+                                                     start
+                                                     UNIT-SECTOR))
+                (end-formatted (unit-format-custom device
+                                                   end-partition
+                                                   UNIT-SECTOR))
+                (new-user-partition (user-partition
+                                     (inherit partition)
+                                     (start start-formatted)
+                                     (end end-formatted)))
+                (new-partition
+                 (mkpart disk new-user-partition)))
+           (if new-partition
+               (cons (user-partition
+                      (inherit new-user-partition)
+                      (file-name (partition-get-path new-partition))
+                      (disk-file-name (device-path device))
+                      (parted-object new-partition))
+                     (loop rest
+                           (if (eq? type 'extended)
+                               remaining-space
+                               (- remaining-space
+                                  (partition-length new-partition)))
+                           (if (eq? type 'extended)
+                               (+ start 1)
+                               (+ (partition-end new-partition) 1))))
+               (error
+                (format #f "Unable to create partition ~a~%" name)))))))))
+
+(define (force-user-partitions-formatting user-partitions)
+  "Set the NEED-FORMATING? fields to #t on all <user-partition> records of
+USER-PARTITIONS list and return the updated list."
+  (map (lambda (p)
+         (user-partition
+          (inherit p)
+          (need-formatting? #t)))
+       user-partitions))
+
+(define* (auto-partition disk
+                         #:key
+                         (scheme 'entire-root))
+  "Automatically create partitions on DISK. All the previous
+partitions (except the ESP on a GPT disk, if present) are wiped. SCHEME is the
+desired partitioning scheme. It can be 'entire-root or
+'entire-root-home. 'entire-root will create a swap partition and a root
+partition occupying all the remaining space. 'entire-root-home will create a
+swap partition, a root partition and a home partition."
+  (let* ((device (disk-device disk))
+         (disk-type (disk-disk-type disk))
+         (has-extended? (disk-type-check-feature
+                         disk-type
+                         DISK-TYPE-FEATURE-EXTENDED))
+         (partitions (filter data-partition? (disk-partitions disk)))
+         (esp-partition (find-esp-partition partitions))
+         ;; According to
+         ;; https://wiki.archlinux.org/index.php/EFI_system_partition, the ESP
+         ;; size should be at least 550MiB.
+         (new-esp-size (nearest-exact-integer
+                        (/ (* 550 MEBIBYTE-SIZE)
+                           (device-sector-size device))))
+         (end-esp-partition (and esp-partition
+                                 (partition-end esp-partition)))
+         (non-boot-partitions (remove esp-partition? partitions))
+         (bios-grub-size (/ (* 3 MEBIBYTE-SIZE)
+                            (device-sector-size device)))
+         (five-percent-disk (nearest-exact-integer
+                             (* 0.05 (device-length device))))
+         (default-swap-size (nearest-exact-integer
+                             (/ (* 4 GIGABYTE-SIZE)
+                                (device-sector-size device))))
+         ;; Use a 4GB size for the swap if it represents less than 5% of the
+         ;; disk space. Otherwise, set the swap size to 5% of the disk space.
+         (swap-size (min default-swap-size five-percent-disk)))
+
+    (if has-extended?
+        ;; msdos - remove everything.
+        (disk-delete-all disk)
+        ;; gpt - remove everything but esp if it exists.
+        (for-each
+         (lambda (partition)
+           (and (data-partition? partition)
+                (disk-remove-partition disk partition)))
+         non-boot-partitions))
+
+    (let* ((start-partition
+            (and (not has-extended?)
+                 (not esp-partition)
+                 (if (efi-installation?)
+                     (user-partition
+                      (fs-type 'fat32)
+                      (esp? #t)
+                      (size new-esp-size)
+                      (mount-point (default-esp-mount-point)))
+                     (user-partition
+                      (fs-type 'ext4)
+                      (bootable? #t)
+                      (bios-grub? #t)
+                      (size bios-grub-size)))))
+           (new-partitions
+            (cond
+             ((or (eq? scheme 'entire-root)
+                  (eq? scheme 'entire-encrypted-root))
+              (let ((encrypted? (eq? scheme 'entire-encrypted-root)))
+                `(,@(if start-partition
+                        `(,start-partition)
+                        '())
+                  ,@(if encrypted?
+                        '()
+                        `(,(user-partition
+                            (fs-type 'swap)
+                            (size swap-size))))
+                  ,(user-partition
+                    (fs-type 'ext4)
+                    (bootable? has-extended?)
+                    (crypt-label (and encrypted? "cryptroot"))
+                    (size "100%")
+                    (mount-point "/")))))
+             ((or (eq? scheme 'entire-root-home)
+                  (eq? scheme 'entire-encrypted-root-home))
+              (let ((encrypted? (eq? scheme 'entire-encrypted-root-home)))
+                `(,@(if start-partition
+                        `(,start-partition)
+                        '())
+                  ,(user-partition
+                    (fs-type 'ext4)
+                    (bootable? has-extended?)
+                    (crypt-label (and encrypted? "cryptroot"))
+                    (size "33%")
+                    (mount-point "/"))
+                  ,@(if has-extended?
+                        `(,(user-partition
+                            (type 'extended)
+                            (size "100%")))
+                        '())
+                  ,@(if encrypted?
+                        '()
+                        `(,(user-partition
+                            (type (if has-extended?
+                                      'logical
+                                      'normal))
+                            (fs-type 'swap)
+                            (size swap-size))))
+                  ,(user-partition
+                    (type (if has-extended?
+                              'logical
+                              'normal))
+                    (fs-type 'ext4)
+                    (crypt-label (and encrypted? "crypthome"))
+                    (size "100%")
+                    (mount-point "/home")))))))
+           (new-partitions* (force-user-partitions-formatting
+                             new-partitions)))
+      (create-adjacent-partitions disk
+                                  new-partitions*
+                                  #:last-partition-end
+                                  (or end-esp-partition 0)))))
+
+
+;;
+;; Convert user-partitions.
+;;
+
+;; No root mount point found.
+(define-condition-type &no-root-mount-point &condition
+  no-root-mount-point?)
+
+(define (check-user-partitions user-partitions)
+  "Return #t if the USER-PARTITIONS lists contains one <user-partition> record
+with a mount-point set to '/', raise &no-root-mount-point condition
+otherwise."
+  (let ((mount-points
+         (map user-partition-mount-point user-partitions)))
+    (or (member "/" mount-points)
+        (raise
+         (condition (&no-root-mount-point))))))
+
+(define (set-user-partitions-file-name user-partitions)
+  "Set the partition file-name of <user-partition> records in USER-PARTITIONS
+list and return the updated list."
+  (map (lambda (p)
+         (let* ((partition (user-partition-parted-object p))
+                (file-name (partition-get-path partition)))
+           (user-partition
+            (inherit p)
+            (file-name file-name))))
+       user-partitions))
+
+(define-syntax-rule (with-null-output-ports exp ...)
+  "Evaluate EXP with both the output port and the error port pointing to the
+bit bucket."
+  (with-output-to-port (%make-void-port "w")
+    (lambda ()
+      (with-error-to-port (%make-void-port "w")
+        (lambda () exp ...)))))
+
+(define (create-ext4-file-system partition)
+  "Create an ext4 file-system for PARTITION file-name."
+  (with-null-output-ports
+   (invoke "mkfs.ext4" "-F" partition)))
+
+(define (create-fat32-file-system partition)
+  "Create an ext4 file-system for PARTITION file-name."
+  (with-null-output-ports
+   (invoke "mkfs.fat" "-F32" partition)))
+
+(define (create-swap-partition partition)
+  "Set up swap area on PARTITION file-name."
+  (with-null-output-ports
+   (invoke "mkswap" "-f" partition)))
+
+(define (call-with-luks-key-file password proc)
+  "Write PASSWORD in a temporary file and pass it to PROC as argument."
+  (call-with-temporary-output-file
+   (lambda (file port)
+     (put-string port password)
+     (close port)
+     (proc file))))
+
+(define (user-partition-upper-file-name user-partition)
+  "Return the file-name of the virtual block device corresponding to
+USER-PARTITION if it is encrypted, or the plain file-name otherwise."
+  (let ((crypt-label (user-partition-crypt-label user-partition))
+        (file-name (user-partition-file-name user-partition)))
+    (if crypt-label
+        (string-append "/dev/mapper/" crypt-label)
+        file-name)))
+
+(define (luks-format-and-open user-partition)
+  "Format and open the encrypted partition pointed by USER-PARTITION."
+  (let* ((file-name (user-partition-file-name user-partition))
+         (label (user-partition-crypt-label user-partition))
+         (password (user-partition-crypt-password user-partition)))
+    (call-with-luks-key-file
+     password
+     (lambda (key-file)
+       (system* "cryptsetup" "-q" "luksFormat" file-name key-file)
+       (system* "cryptsetup" "open" "--type" "luks"
+                "--key-file" key-file file-name label)))))
+
+(define (luks-close user-partition)
+  "Close the encrypted partition pointed by USER-PARTITION."
+  (let ((label (user-partition-crypt-label user-partition)))
+    (system* "cryptsetup" "close" label)))
+
+(define (format-user-partitions user-partitions)
+  "Format the <user-partition> records in USER-PARTITIONS list with
+NEED-FORMATING? field set to #t."
+  (for-each
+   (lambda (user-partition)
+     (let* ((need-formatting?
+             (user-partition-need-formatting? user-partition))
+            (type (user-partition-type user-partition))
+            (crypt-label (user-partition-crypt-label user-partition))
+            (file-name (user-partition-upper-file-name user-partition))
+            (fs-type (user-partition-fs-type user-partition)))
+       (when crypt-label
+         (luks-format-and-open user-partition))
+
+       (case fs-type
+         ((ext4)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-ext4-file-system file-name)))
+         ((fat32)
+          (and need-formatting?
+               (not (eq? type 'extended))
+               (create-fat32-file-system file-name)))
+         ((swap)
+          (create-swap-partition file-name))
+         (else
+          ;; TODO: Add support for other file-system types.
+          #t))))
+   user-partitions))
+
+(define (sort-partitions user-partitions)
+  "Sort USER-PARTITIONS by mount-points, so that the more nested mount-point
+comes last. This is useful to mount/umount partitions in a coherent order."
+  (sort user-partitions
+        (lambda (a b)
+          (let ((mount-point-a (user-partition-mount-point a))
+                (mount-point-b (user-partition-mount-point b)))
+            (string-prefix? mount-point-a mount-point-b)))))
+
+(define (mount-user-partitions user-partitions)
+  "Mount the <user-partition> records in USER-PARTITIONS list on their
+respective mount-points."
+  (let* ((mount-partitions (filter user-partition-mount-point user-partitions))
+         (sorted-partitions (sort-partitions mount-partitions)))
+    (for-each (lambda (user-partition)
+                (let* ((mount-point
+                        (user-partition-mount-point user-partition))
+                       (target
+                        (string-append (%installer-target-dir)
+                                       mount-point))
+                       (fs-type
+                        (user-partition-fs-type user-partition))
+                       (crypt-label
+                        (user-partition-crypt-label user-partition))
+                       (mount-type
+                        (user-fs-type->mount-type fs-type))
+                       (file-name
+                        (user-partition-upper-file-name user-partition)))
+                  (mkdir-p target)
+                  (mount file-name target mount-type)))
+              sorted-partitions)))
+
+(define (umount-user-partitions user-partitions)
+  "Unmount all the <user-partition> records in USER-PARTITIONS list."
+  (let* ((mount-partitions (filter user-partition-mount-point user-partitions))
+         (sorted-partitions (sort-partitions mount-partitions)))
+    (for-each (lambda (user-partition)
+                (let* ((mount-point
+                        (user-partition-mount-point user-partition))
+                       (crypt-label
+                        (user-partition-crypt-label user-partition))
+                       (target
+                        (string-append (%installer-target-dir)
+                                       mount-point)))
+                  (umount target)
+                  (when crypt-label
+                    (luks-close user-partition))))
+              (reverse sorted-partitions))))
+
+(define (find-swap-user-partitions user-partitions)
+  "Return the subset of <user-partition> records in USER-PARTITIONS list with
+the FS-TYPE field set to 'swap, return the empty list if none found."
+  (filter (lambda (user-partition)
+            (let ((fs-type (user-partition-fs-type user-partition)))
+              (eq? fs-type 'swap)))
+          user-partitions))
+
+(define (start-swapping user-partitions)
+  "Start swaping on <user-partition> records with FS-TYPE equal to 'swap."
+  (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
+         (swap-devices (map user-partition-file-name swap-user-partitions)))
+    (for-each swapon swap-devices)))
+
+(define (stop-swapping user-partitions)
+  "Stop swaping on <user-partition> records with FS-TYPE equal to 'swap."
+  (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
+         (swap-devices (map user-partition-file-name swap-user-partitions)))
+    (for-each swapoff swap-devices)))
+
+(define-syntax-rule (with-mounted-partitions user-partitions exp ...)
+  "Mount USER-PARTITIONS and start swapping within the dynamic extent of EXP."
+  (dynamic-wind
+    (lambda ()
+      (mount-user-partitions user-partitions)
+      (start-swapping user-partitions))
+    (lambda ()
+      exp ...)
+    (lambda ()
+      (umount-user-partitions user-partitions)
+      (stop-swapping user-partitions)
+      #f)))
+
+(define (user-partition->file-system user-partition)
+  "Convert the given USER-PARTITION record in a FILE-SYSTEM record from
+(gnu system file-systems) module and return it."
+  (let* ((mount-point (user-partition-mount-point user-partition))
+         (fs-type (user-partition-fs-type user-partition))
+         (crypt-label (user-partition-crypt-label user-partition))
+         (mount-type (user-fs-type->mount-type fs-type))
+         (file-name (user-partition-file-name user-partition))
+         (upper-file-name (user-partition-upper-file-name user-partition))
+         ;; Only compute uuid if partition is not encrypted.
+         (uuid (or crypt-label
+                   (uuid->string (read-partition-uuid file-name) fs-type))))
+    `(file-system
+       (mount-point ,mount-point)
+       (device ,@(if crypt-label
+                     `(,upper-file-name)
+                     `((uuid ,uuid (quote ,fs-type)))))
+       (type ,mount-type)
+       ,@(if crypt-label
+             '((dependencies mapped-devices))
+             '()))))
+
+(define (user-partitions->file-systems user-partitions)
+  "Convert the given USER-PARTITIONS list of <user-partition> records into a
+list of <file-system> records."
+  (filter-map
+   (lambda (user-partition)
+     (let ((mount-point
+            (user-partition-mount-point user-partition)))
+       (and mount-point
+            (user-partition->file-system user-partition))))
+   user-partitions))
+
+(define (user-partition->mapped-device user-partition)
+  "Convert the given USER-PARTITION record into a MAPPED-DEVICE record
+from (gnu system mapped-devices) and return it."
+  (let ((label (user-partition-crypt-label user-partition))
+        (file-name (user-partition-file-name user-partition)))
+    `(mapped-device
+      (source (uuid ,(uuid->string
+                      (read-luks-partition-uuid file-name)
+                      'luks)))
+      (target ,label)
+      (type luks-device-mapping))))
+
+(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))
+         (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)))))))
+
+(define (user-partitions->configuration user-partitions)
+  "Return the configuration field for USER-PARTITIONS."
+  (let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
+         (swap-devices (map user-partition-file-name swap-user-partitions))
+         (encrypted-partitions
+          (filter user-partition-crypt-label user-partitions)))
+    `(,@(if (null? swap-devices)
+            '()
+            `((swap-devices (list ,@swap-devices))))
+      (bootloader ,@(bootloader-configuration user-partitions))
+      ,@(if (null? encrypted-partitions)
+            '()
+            `((mapped-devices
+               (list ,@(map user-partition->mapped-device
+                            encrypted-partitions)))))
+      (file-systems (cons*
+                     ,@(user-partitions->file-systems user-partitions)
+                     %base-file-systems)))))
+
+
+;;
+;; Initialization.
+;;
+
+(define (init-parted)
+  "Initialize libparted support."
+  (probe-all-devices)
+  (exception-set-handler (lambda (exception)
+                           EXCEPTION-OPTION-UNHANDLED)))
+
+(define (free-parted devices)
+  "Deallocate memory used for DEVICES in parted, force sync them and wait for
+the devices not to be used before returning."
+  ;; XXX: Formatting and further operations on disk partition table may fail
+  ;; because the partition table changes are not synced, or because the device
+  ;; is still in use, even if parted should have finished editing
+  ;; partitions. This is not well understood, but syncing devices and waiting
+  ;; them to stop returning EBUSY to BLKRRPART ioctl seems to be enough. The
+  ;; same kind of issue is described here:
+  ;; https://mail.gnome.org/archives/commits-list/2013-March/msg18423.html.
+  (let ((device-file-names (map device-path devices)))
+    (for-each force-device-sync devices)
+    (free-all-devices)
+    (for-each (lambda (file-name)
+                (let ((in-use? (with-delay-device-in-use? file-name)))
+                  (and in-use?
+                       (error
+                        (format #f (G_ "Device ~a is still in use.")
+                                file-name)))))
+              device-file-names)))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
new file mode 100644
index 0000000000..edf73b6215
--- /dev/null
+++ b/gnu/installer/record.scm
@@ -0,0 +1,84 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer record)
+  #:use-module (guix records)
+  #:use-module (srfi srfi-1)
+  #:export (<installer>
+            installer
+            make-installer
+            installer?
+            installer-name
+            installer-init
+            installer-exit
+            installer-exit-error
+            installer-final-page
+            installer-keymap-page
+            installer-locale-page
+            installer-menu-page
+            installer-network-page
+            installer-timezone-page
+            installer-hostname-page
+            installer-user-page
+            installer-partition-page
+            installer-services-page
+            installer-welcome-page))
+
+
+;;;
+;;; Installer record.
+;;;
+
+;; The <installer> record contains pages that will be run to prompt the user
+;; for the system configuration. The goal of the installer is to produce a
+;; complete <operating-system> record and install it.
+
+(define-record-type* <installer>
+  installer make-installer
+  installer?
+  ;; symbol
+  (name installer-name)
+  ;; procedure: void -> void
+  (init installer-init)
+  ;; procedure: void -> void
+  (exit installer-exit)
+  ;; procedure (key arguments) -> void
+  (exit-error installer-exit-error)
+  ;; procedure void -> void
+  (final-page installer-final-page)
+  ;; procedure (layouts) -> (list layout variant)
+  (keymap-page installer-keymap-page)
+  ;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
+  ;; -> glibc-locale
+  (locale-page installer-locale-page)
+  ;; procedure: (steps) -> step-id
+  (menu-page installer-menu-page)
+  ;; procedure void -> void
+  (network-page installer-network-page)
+  ;; procedure (zonetab) -> posix-timezone
+  (timezone-page installer-timezone-page)
+  ;; procedure void -> void
+  (hostname-page installer-hostname-page)
+  ;; procedure void -> void
+  (user-page installer-user-page)
+  ;; procedure void -> void
+  (partition-page installer-partition-page)
+  ;; procedure void -> void
+  (services-page installer-services-page)
+  ;; procedure (logo) -> void
+  (welcome-page installer-welcome-page))
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
new file mode 100644
index 0000000000..ed44b87682
--- /dev/null
+++ b/gnu/installer/services.scm
@@ -0,0 +1,59 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer services)
+  #:use-module (guix records)
+  #:export (<desktop-environment>
+            desktop-environment
+            make-desktop-environment
+            desktop-environment-name
+            desktop-environment-snippet
+
+            %desktop-environments
+            desktop-environments->configuration))
+
+(define-record-type* <desktop-environment>
+  desktop-environment make-desktop-environment
+  desktop-environment?
+  (name            desktop-environment-name) ;string
+  (snippet         desktop-environment-snippet)) ;symbol
+
+;; 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)))))))
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
new file mode 100644
index 0000000000..3f0bdad4f7
--- /dev/null
+++ b/gnu/installer/steps.scm
@@ -0,0 +1,237 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer steps)
+  #:use-module (guix records)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (rnrs io ports)
+  #:export (&installer-step-abort
+            installer-step-abort?
+
+            &installer-step-break
+            installer-step-break?
+
+            <installer-step>
+            installer-step
+            make-installer-step
+            installer-step?
+            installer-step-id
+            installer-step-description
+            installer-step-compute
+            installer-step-configuration-formatter
+
+            run-installer-steps
+            find-step-by-id
+            result->step-ids
+            result-step
+            result-step-done?
+
+            %installer-configuration-file
+            %installer-target-dir
+            %configuration-file-width
+            format-configuration
+            configuration->file))
+
+;; This condition may be raised to abort the current step.
+(define-condition-type &installer-step-abort &condition
+  installer-step-abort?)
+
+;; This condition may be raised to break out from the steps execution.
+(define-condition-type &installer-step-break &condition
+  installer-step-break?)
+
+;; An installer-step record is basically an id associated to a compute
+;; procedure. The COMPUTE procedure takes exactly one argument, an association
+;; list containing the results of previously executed installer-steps (see
+;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
+;; procedure will be stored in the results list passed to the next
+;; installer-step and so on.
+(define-record-type* <installer-step>
+  installer-step make-installer-step
+  installer-step?
+  (id                         installer-step-id) ;symbol
+  (description                installer-step-description ;string
+                              (default #f))
+  (compute                    installer-step-compute) ;procedure
+  (configuration-formatter    installer-step-configuration-formatter ;procedure
+                              (default #f)))
+
+(define* (run-installer-steps #:key
+                              steps
+                              (rewind-strategy 'previous)
+                              (menu-proc (const #f)))
+  "Run the COMPUTE procedure of all <installer-step> records in STEPS
+sequencially. If the &installer-step-abort condition is raised, fallback to a
+previous install-step, accordingly to the specified REWIND-STRATEGY.
+
+REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
+is selected, the execution will resume at the previous installer-step. If
+'menu is selected, the MENU-PROC procedure will be called. Its return value
+has to be an installer-step ID to jump to. The ID has to be the one of a
+previously executed step. It is impossible to jump forward. Finally if 'start
+is selected, the execution will resume at the first installer-step.
+
+The result of every COMPUTE procedures is stored in an association list, under
+the form:
+
+		'((STEP-ID . COMPUTE-RESULT) ...)
+
+where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
+result of the associated COMPUTE procedure. This result association list is
+passed as argument of every COMPUTE procedure. It is finally returned when the
+computation is over.
+
+If the &installer-step-break condition is raised, stop the computation and
+return the accumalated result so far."
+  (define (pop-result list)
+    (cdr list))
+
+  (define (first-step? steps step)
+    (match steps
+      ((first-step . rest-steps)
+       (equal? first-step step))))
+
+  (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))
+           (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)))))
+
+  (define* (run result #:key todo-steps done-steps)
+    (match todo-steps
+      (() (reverse result))
+      ((step . rest-steps)
+       (guard (c ((installer-step-abort? c)
+                  (case rewind-strategy
+                    ((previous)
+                     (match done-steps
+                       (()
+                        ;; We cannot go previous the first step. So re-raise
+                        ;; the exception. It might be useful in the case of
+                        ;; nested run-installer-steps. Abort to 'raise-above
+                        ;; prompt to prevent the condition from being catched
+                        ;; by one of the previously installed guard.
+                        (abort-to-prompt 'raise-above c))
+                       ((prev-done ... last-done)
+                        (run (pop-result result)
+                             #:todo-steps (cons last-done todo-steps)
+                             #:done-steps prev-done))))
+                    ((menu)
+                     (let ((goto-step (menu-proc
+                                       (append done-steps (list step)))))
+                       (if (eq? goto-step step)
+                           (run result
+                                #:todo-steps todo-steps
+                                #:done-steps done-steps)
+                           (skip-to-step goto-step result
+                                         #:todo-steps todo-steps
+                                         #:done-steps done-steps))))
+                    ((start)
+                     (if (null? done-steps)
+                         ;; Same as above, it makes no sense to jump to start
+                         ;; when we are at the first installer-step. Abort to
+                         ;; 'raise-above prompt to re-raise the condition.
+                         (abort-to-prompt 'raise-above c)
+                         (run '()
+                              #:todo-steps steps
+                              #:done-steps '())))))
+                 ((installer-step-break? c)
+                  (reverse result)))
+         (let* ((id (installer-step-id step))
+                (compute (installer-step-compute step))
+                (res (compute result done-steps)))
+           (run (alist-cons id res result)
+                #:todo-steps rest-steps
+                #:done-steps (append done-steps (list step))))))))
+
+  (call-with-prompt 'raise-above
+    (lambda ()
+      (run '()
+           #:todo-steps steps
+           #:done-steps '()))
+    (lambda (k condition)
+      (raise condition))))
+
+(define (find-step-by-id steps id)
+  "Find and return the step in STEPS whose id is equal to ID."
+  (find (lambda (step)
+          (eq? (installer-step-id step) id))
+        steps))
+
+(define (result-step results step-id)
+  "Return the result of the installer-step specified by STEP-ID in
+RESULTS."
+  (assoc-ref results step-id))
+
+(define (result-step-done? results step-id)
+  "Return #t if the installer-step specified by STEP-ID has a COMPUTE value
+stored in RESULTS. Return #f otherwise."
+  (and (assoc step-id results) #t))
+
+(define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
+(define %installer-target-dir (make-parameter "/mnt"))
+(define %configuration-file-width (make-parameter 79))
+
+(define (format-configuration steps results)
+  "Return the list resulting from the application of the procedure defined in
+CONFIGURATION-FORMATTER field of <installer-step> on the associated result
+found in RESULTS."
+  (let ((configuration
+         (append-map
+          (lambda (step)
+            (let* ((step-id (installer-step-id step))
+                   (conf-formatter
+                    (installer-step-configuration-formatter step))
+                   (result-step (result-step results step-id)))
+              (if (and result-step conf-formatter)
+                  (conf-formatter result-step)
+                  '())))
+          steps))
+        (modules '((use-modules (gnu))
+                   (use-service-modules desktop))))
+    `(,@modules
+      ()
+      (operating-system ,@configuration))))
+
+(define* (configuration->file configuration
+                              #:key (filename (%installer-configuration-file)))
+  "Write the given CONFIGURATION to FILENAME."
+  (mkdir-p (dirname filename))
+  (call-with-output-file filename
+    (lambda (port)
+      (format port ";; This is an operating system configuration generated~%")
+      (format port ";; by the graphical installer.~%")
+      (newline port)
+      (for-each (lambda (part)
+                  (if (null? part)
+                      (newline port)
+                      (pretty-print part port)))
+                configuration)
+      (flush-output-port port))))
diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm
new file mode 100644
index 0000000000..32bc2ed6bb
--- /dev/null
+++ b/gnu/installer/timezone.scm
@@ -0,0 +1,127 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer timezone)
+  #:use-module (gnu installer utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:export (locate-childrens
+            timezone->posix-tz
+            timezone-has-child?
+            zonetab->timezone-tree
+            posix-tz->configuration))
+
+(define %not-blank
+  (char-set-complement char-set:blank))
+
+(define (posix-tz->timezone tz)
+  "Convert given TZ in Posix format like \"Europe/Paris\" into a list like
+(\"Europe\" \"Paris\")."
+  (string-split tz #\/))
+
+(define (timezone->posix-tz timezone)
+  "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone
+like \"Europe/Paris\"."
+  (string-join timezone "/"))
+
+(define (zonetab->timezones zonetab)
+  "Parse ZONETAB file and return the corresponding list of timezones."
+
+  (define (zonetab-line->posix-tz line)
+    (let ((tokens (string-tokenize line %not-blank)))
+      (match tokens
+        ((code coordinates tz _ ...)
+         tz))))
+
+  (call-with-input-file zonetab
+    (lambda (port)
+      (let* ((lines (read-lines port))
+             ;; Filter comment lines starting with '#' character.
+             (tz-lines (filter (lambda (line)
+                                 (not (eq? (string-ref line 0)
+                                           #\#)))
+                               lines)))
+        (map (lambda (line)
+               (posix-tz->timezone
+                (zonetab-line->posix-tz line)))
+             tz-lines)))))
+
+(define (timezones->timezone-tree timezones)
+  "Convert the list of timezones, TIMEZONES into a tree under the form:
+
+	(\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\"))
+
+representing America/North_Dakota/New_Salem and America/North_Dakota/Center
+timezones."
+
+  (define (remove-first lists)
+    "Remove the first element of every sublists in the argument LISTS."
+    (map (lambda (list)
+           (if (null? list) list (cdr list)))
+         lists))
+
+  (let loop ((cur-timezones timezones))
+    (match cur-timezones
+      (() '())
+      (((region . rest-region) . rest-timezones)
+       (if (null? rest-region)
+           (cons (list region) (loop rest-timezones))
+           (receive (same-region other-region)
+               (partition (lambda (timezone)
+                            (string=? (car timezone) region))
+                          cur-timezones)
+             (acons region
+                    (loop (remove-first same-region))
+                    (loop other-region))))))))
+
+(define (locate-childrens tree path)
+  "Return the childrens of the timezone indicated by PATH in the given
+TREE. Raise a condition if the PATH could not be found."
+  (let ((extract-proc (cut map car <>)))
+    (match path
+      (() (sort (extract-proc tree) string<?))
+      ((region . rest)
+       (or (and=> (assoc-ref tree region)
+                  (cut locate-childrens <> rest))
+           (raise
+            (condition
+             (&message
+              (message
+               (format #f (G_ "Unable to locate path: ~a.") path))))))))))
+
+(define (timezone-has-child? tree timezone)
+  "Return #t if the given TIMEZONE any child in TREE and #f otherwise."
+  (not (null? (locate-childrens tree timezone))))
+
+(define* (zonetab->timezone-tree zonetab)
+  "Return the timezone tree corresponding to the given ZONETAB file."
+  (timezones->timezone-tree (zonetab->timezones zonetab)))
+
+
+;;;
+;;; Configuration formatter.
+;;;
+
+(define (posix-tz->configuration timezone)
+  "Return the configuration field for TIMEZONE."
+  `((timezone ,timezone)))
diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm
new file mode 100644
index 0000000000..1f8d40a011
--- /dev/null
+++ b/gnu/installer/user.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer user)
+  #:use-module (guix records)
+  #:export (<user>
+            user
+            make-user
+            user-name
+            user-group
+            user-home-directory
+
+            users->configuration))
+
+(define-record-type* <user>
+  user make-user
+  user?
+  (name            user-name)
+  (group           user-group
+                   (default "users"))
+  (home-directory  user-home-directory))
+
+(define (users->configuration users)
+  "Return the configuration field for USERS."
+  `((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))))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
new file mode 100644
index 0000000000..e91f90a84d
--- /dev/null
+++ b/gnu/installer/utils.scm
@@ -0,0 +1,63 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; 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 installer utils)
+  #:use-module (guix utils)
+  #:use-module (guix build utils)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 textual-ports)
+  #:export (read-lines
+            read-all
+            nearest-exact-integer
+            read-percentage
+            run-shell-command))
+
+(define* (read-lines #:optional (port (current-input-port)))
+  "Read lines from PORT and return them as a list."
+  (let loop ((line (read-line port))
+             (lines '()))
+    (if (eof-object? line)
+        (reverse lines)
+        (loop (read-line port)
+              (cons line lines)))))
+
+(define (read-all file)
+  "Return the content of the given FILE as a string."
+  (call-with-input-file file
+    get-string-all))
+
+(define (nearest-exact-integer x)
+  "Given a real number X, return the nearest exact integer, with ties going to
+the nearest exact even integer."
+  (inexact->exact (round x)))
+
+(define (read-percentage percentage)
+  "Read PERCENTAGE string and return the corresponding percentage as a
+number. If no percentage is found, return #f"
+  (let ((result (string-match "^([0-9]+)%$" percentage)))
+    (and result
+         (string->number (match:substring result 1)))))
+
+(define (run-shell-command command)
+  (call-with-temporary-output-file
+   (lambda (file port)
+     (format port "~a~%" command)
+     ;; (format port "exit~%")
+     (close port)
+     (invoke "bash" "--init-file" file))))
diff --git a/gnu/local.mk b/gnu/local.mk
index f4de1a44a4..5deae50336 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -46,6 +46,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/bootloader/grub.scm                       \
   %D%/bootloader/extlinux.scm                   \
   %D%/bootloader/u-boot.scm                     \
+  %D%/ci.scm					\
   %D%/packages.scm				\
   %D%/packages/abduco.scm			\
   %D%/packages/abiword.scm			\
@@ -112,6 +113,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/conky.scm			\
   %D%/packages/connman.scm			\
   %D%/packages/cook.scm				\
+  %D%/packages/coq.scm				\
   %D%/packages/cpio.scm				\
   %D%/packages/cpp.scm 				\
   %D%/packages/cppi.scm				\
@@ -126,6 +128,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/datamash.scm			\
   %D%/packages/datastructures.scm		\
   %D%/packages/dav.scm				\
+  %D%/packages/dbm.scm				\
   %D%/packages/dc.scm				\
   %D%/packages/debian.scm			\
   %D%/packages/debug.scm			\
@@ -154,6 +157,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/elixir.scm			\
   %D%/packages/embedded.scm			\
   %D%/packages/emacs.scm			\
+  %D%/packages/emacs-xyz.scm			\
   %D%/packages/emulators.scm			\
   %D%/packages/enchant.scm			\
   %D%/packages/engineering.scm			\
@@ -348,6 +352,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/pem.scm				\
   %D%/packages/perl.scm				\
   %D%/packages/perl-check.scm			\
+  %D%/packages/perl-compression.scm		\
   %D%/packages/perl-web.scm			\
   %D%/packages/photo.scm			\
   %D%/packages/phabricator.scm 			\
@@ -366,8 +371,10 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/pure.scm				\
   %D%/packages/pv.scm				\
   %D%/packages/python.scm			\
+  %D%/packages/python-compression.scm		\
   %D%/packages/python-crypto.scm		\
   %D%/packages/python-web.scm			\
+  %D%/packages/python-xyz.scm			\
   %D%/packages/toys.scm				\
   %D%/packages/tryton.scm			\
   %D%/packages/qt.scm				\
@@ -410,6 +417,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/packages/sml.scm				\
   %D%/packages/speech.scm			\
   %D%/packages/spice.scm			\
+  %D%/packages/sqlite.scm			\
   %D%/packages/ssh.scm				\
   %D%/packages/sssd.scm				\
   %D%/packages/stalonetray.scm			\
@@ -555,9 +563,47 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/ssh.scm				\
   %D%/tests/version-control.scm			\
   %D%/tests/virtualization.scm			\
-  %D%/tests/web.scm				\
+  %D%/tests/web.scm
+
+if ENABLE_INSTALLER
+
+GNU_SYSTEM_MODULES +=                           \
+  %D%/installer.scm      			\
+  %D%/installer/connman.scm			\
+  %D%/installer/final.scm			\
+  %D%/installer/hostname.scm			\
+  %D%/installer/keymap.scm			\
+  %D%/installer/locale.scm			\
+  %D%/installer/newt.scm			\
+  %D%/installer/parted.scm			\
+  %D%/installer/record.scm		        \
+  %D%/installer/services.scm			\
+  %D%/installer/steps.scm			\
+  %D%/installer/timezone.scm			\
+  %D%/installer/user.scm			\
+  %D%/installer/utils.scm			\
 						\
-  %D%/ci.scm
+  %D%/installer/newt/ethernet.scm		\
+  %D%/installer/newt/final.scm  		\
+  %D%/installer/newt/hostname.scm		\
+  %D%/installer/newt/keymap.scm			\
+  %D%/installer/newt/locale.scm			\
+  %D%/installer/newt/menu.scm			\
+  %D%/installer/newt/network.scm		\
+  %D%/installer/newt/page.scm			\
+  %D%/installer/newt/partition.scm		\
+  %D%/installer/newt/services.scm		\
+  %D%/installer/newt/timezone.scm		\
+  %D%/installer/newt/utils.scm			\
+  %D%/installer/newt/welcome.scm		\
+  %D%/installer/newt/wifi.scm	
+
+installerdir = $(guilemoduledir)/%D%/installer
+dist_installer_DATA =				\
+  %D%/installer/aux-files/logo.txt	        \
+  %D%/installer/aux-files/SUPPORTED
+
+endif ENABLE_INSTALLER
 
 # Modules that do not need to be compiled.
 MODULES_NOT_COMPILED +=				\
@@ -866,6 +912,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kinit-kdeinit-libpath.patch		\
   %D%/packages/patches/kio-search-smbd-on-PATH.patch		\
   %D%/packages/patches/kmod-module-directory.patch		\
+  %D%/packages/patches/kmscon-runtime-keymap-switch.patch	\
   %D%/packages/patches/kpackage-allow-external-paths.patch	\
   %D%/packages/patches/kobodeluxe-paths.patch			\
   %D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch	\
@@ -873,6 +920,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/kobodeluxe-manpage-minus-not-hyphen.patch	\
   %D%/packages/patches/kobodeluxe-midicon-segmentation-fault.patch	\
   %D%/packages/patches/kobodeluxe-graphics-window-signed-char.patch	\
+  %D%/packages/patches/kodi-skip-test-449.patch		\
   %D%/packages/patches/laby-make-install.patch			\
   %D%/packages/patches/ldc-bootstrap-disable-tests.patch	\
   %D%/packages/patches/ldc-disable-phobos-tests.patch		\
@@ -929,7 +977,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/libsndfile-CVE-2017-8361-8363-8365.patch	\
   %D%/packages/patches/libsndfile-CVE-2017-8362.patch		\
   %D%/packages/patches/libsndfile-CVE-2017-12562.patch		\
-  %D%/packages/patches/libssh-hostname-parser-bug.patch		\
   %D%/packages/patches/libssh2-fix-build-failure-with-gcrypt.patch	\
   %D%/packages/patches/libtar-CVE-2013-4420.patch 		\
   %D%/packages/patches/libtheora-config-guess.patch		\
@@ -1029,11 +1076,13 @@ dist_patch_DATA =						\
   %D%/packages/patches/ola-readdir-r.patch			\
   %D%/packages/patches/openbabel-fix-crash-on-nwchem-output.patch	\
   %D%/packages/patches/opencascade-oce-glibc-2.26.patch		\
+  %D%/packages/patches/opencv-rgbd-aarch64-test-fix.patch	\
   %D%/packages/patches/openfoam-4.1-cleanup.patch			\
   %D%/packages/patches/openjdk-10-idlj-reproducibility.patch	\
   %D%/packages/patches/openldap-CVE-2017-9287.patch		\
   %D%/packages/patches/openocd-nrf52.patch			\
   %D%/packages/patches/opensmtpd-fix-crash.patch		\
+  %D%/packages/patches/openssh-CVE-2018-20685.patch		\
   %D%/packages/patches/openssl-runpath.patch			\
   %D%/packages/patches/openssl-1.1-c-rehash-in.patch		\
   %D%/packages/patches/openssl-c-rehash-in.patch		\
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 532297239d..a1814205f9 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
@@ -28,11 +28,14 @@
   #:use-module (guix memoization)
   #:use-module ((guix build utils)
                 #:select ((package-name->name+version
-                           . hyphen-separated-name->name+version)))
+                           . hyphen-separated-name->name+version)
+                          mkdir-p))
   #:autoload   (guix profiles) (packages->manifest)
   #:use-module (guix describe)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
+  #:autoload   (ice-9 binary-ports) (put-bytevector)
+  #:autoload   (system base compile) (compile)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -50,14 +53,18 @@
             %default-package-module-path
 
             fold-packages
+            fold-available-packages
 
             find-packages-by-name
+            find-package-locations
             find-best-packages-by-name
-            find-newest-available-packages
 
             specification->package
             specification->package+output
-            specifications->manifest))
+            specification->location
+            specifications->manifest
+
+            generate-package-cache))
 
 ;;; Commentary:
 ;;;
@@ -136,6 +143,14 @@ for system '~a'")
   ;; Default search path for package modules.
   `((,%distro-root-directory . "gnu/packages")))
 
+(define (cache-is-authoritative?)
+  "Return true if the pre-computed package cache is authoritative.  It is not
+authoritative when entries have been added via GUIX_PACKAGE_PATH or '-L'
+flags."
+  (equal? (%package-module-path)
+          (append %default-package-module-path
+                  (package-path-entries))))
+
 (define %package-module-path
   ;; Search path for package modules.  Each item must be either a directory
   ;; name or a pair whose car is a directory and whose cdr is a sub-directory
@@ -168,6 +183,50 @@ for system '~a'")
               directory))
         %load-path)))
 
+(define (fold-available-packages proc init)
+  "Fold PROC over the list of available packages.  For each available package,
+PROC is called along these lines:
+
+  (PROC NAME VERSION RESULT
+        #:outputs OUTPUTS
+        #:location LOCATION
+        …)
+
+PROC can use #:allow-other-keys to ignore the bits it's not interested in.
+When a package cache is available, this procedure does not actually load any
+package module."
+  (define cache
+    (load-package-cache (current-profile)))
+
+  (if (and cache (cache-is-authoritative?))
+      (vhash-fold (lambda (name vector result)
+                    (match vector
+                      (#(name version module symbol outputs
+                              supported? deprecated?
+                              file line column)
+                       (proc name version result
+                             #:outputs outputs
+                             #:location (and file
+                                             (location file line column))
+                             #:supported? supported?
+                             #:deprecated? deprecated?))))
+                  init
+                  cache)
+      (fold-packages (lambda (package result)
+                       (proc (package-name package)
+                             (package-version package)
+                             result
+                             #:outputs (package-outputs package)
+                             #:location (package-location package)
+                             #:supported?
+                             (->bool
+                              (member (%current-system)
+                                      (package-supported-systems package)))
+                             #:deprecated?
+                             (->bool
+                              (package-superseded package))))
+                     init)))
+
 (define* (fold-packages proc init
                         #:optional
                         (modules (all-modules (%package-module-path)
@@ -184,7 +243,35 @@ is guaranteed to never traverse the same package twice."
                                 init
                                 modules))
 
-(define find-packages-by-name
+(define %package-cache-file
+  ;; Location of the package cache.
+  "/lib/guix/package.cache")
+
+(define load-package-cache
+  (mlambda (profile)
+    "Attempt to load the package cache.  On success return a vhash keyed by
+package names.  Return #f on failure."
+    (match profile
+      (#f #f)
+      (profile
+       (catch 'system-error
+         (lambda ()
+           (define lst
+             (load-compiled (string-append profile %package-cache-file)))
+           (fold (lambda (item vhash)
+                   (match item
+                     (#(name version module symbol outputs
+                             supported? deprecated?
+                             file line column)
+                      (vhash-cons name item vhash))))
+                 vlist-null
+                 lst))
+         (lambda args
+           (if (= ENOENT (system-error-errno args))
+               #f
+               (apply throw args))))))))
+
+(define find-packages-by-name/direct              ;bypass the cache
   (let ((packages (delay
                     (fold-packages (lambda (p r)
                                      (vhash-cons (package-name p) p r))
@@ -203,28 +290,61 @@ decreasing version order."
                     matching)
             matching)))))
 
-(define find-newest-available-packages
-  (mlambda ()
-    "Return a vhash keyed by package names, and with
-associated values of the form
-
-  (newest-version newest-package ...)
-
-where the preferred package is listed first."
-
-    ;; FIXME: Currently, the preferred package is whichever one
-    ;; was found last by 'fold-packages'.  Find a better solution.
-    (fold-packages (lambda (p r)
-                     (let ((name    (package-name p))
-                           (version (package-version p)))
-                       (match (vhash-assoc name r)
-                         ((_ newest-so-far . pkgs)
-                          (case (version-compare version newest-so-far)
-                            ((>) (vhash-cons name `(,version ,p) r))
-                            ((=) (vhash-cons name `(,version ,p ,@pkgs) r))
-                            ((<) r)))
-                         (#f (vhash-cons name `(,version ,p) r)))))
-                   vlist-null)))
+(define (cache-lookup cache name)
+  "Lookup package NAME in CACHE.  Return a list sorted in increasing version
+order."
+  (define (package-version<? v1 v2)
+    (version>? (vector-ref v2 1) (vector-ref v1 1)))
+
+  (sort (vhash-fold* cons '() name cache)
+        package-version<?))
+
+(define* (find-packages-by-name name #:optional version)
+  "Return the list of packages with the given NAME.  If VERSION is not #f,
+then only return packages whose version is prefixed by VERSION, sorted in
+decreasing version order."
+  (define cache
+    (load-package-cache (current-profile)))
+
+  (if (and (cache-is-authoritative?) cache)
+      (match (cache-lookup cache name)
+        (#f #f)
+        ((#(_ versions modules symbols _ _ _ _ _ _) ...)
+         (fold (lambda (version* module symbol result)
+                 (if (or (not version)
+                         (version-prefix? version version*))
+                     (cons (module-ref (resolve-interface module)
+                                       symbol)
+                           result)
+                     result))
+               '()
+               versions modules symbols)))
+      (find-packages-by-name/direct name version)))
+
+(define* (find-package-locations name #:optional version)
+  "Return a list of version/location pairs corresponding to each package
+matching NAME and VERSION."
+  (define cache
+    (load-package-cache (current-profile)))
+
+  (if (and cache (cache-is-authoritative?))
+      (match (cache-lookup cache name)
+        (#f '())
+        ((#(name versions modules symbols outputs
+                 supported? deprecated?
+                 files lines columns) ...)
+         (fold (lambda (version* file line column result)
+                 (if (and file
+                          (or (not version)
+                              (version-prefix? version version*)))
+                     (alist-cons version* (location file line column)
+                                 result)
+                     result))
+               '()
+               versions files lines columns)))
+      (map (lambda (package)
+             (cons (package-version package) (package-location package)))
+           (find-packages-by-name/direct name version))))
 
 (define (find-best-packages-by-name name version)
   "If version is #f, return the list of packages named NAME with the highest
@@ -232,9 +352,64 @@ version numbers; otherwise, return the list of packages named NAME and at
 VERSION."
   (if version
       (find-packages-by-name name version)
-      (match (vhash-assoc name (find-newest-available-packages))
-        ((_ version pkgs ...) pkgs)
-        (#f '()))))
+      (match (find-packages-by-name name)
+        (()
+         '())
+        ((matches ...)
+         ;; Return the subset of MATCHES with the higher version number.
+         (let ((highest (package-version (first matches))))
+           (take-while (lambda (p)
+                         (string=? (package-version p) highest))
+                       matches))))))
+
+(define (generate-package-cache directory)
+  "Generate under DIRECTORY a cache of all the available packages.
+
+The primary purpose of the cache is to speed up package lookup by name such
+that we don't have to traverse and load all the package modules, thereby also
+reducing the memory footprint."
+  (define cache-file
+    (string-append directory %package-cache-file))
+
+  (define (expand-cache module symbol variable result)
+    (match (false-if-exception (variable-ref variable))
+      ((? package? package)
+       (if (hidden-package? package)
+           result
+           (cons `#(,(package-name package)
+                    ,(package-version package)
+                    ,(module-name module)
+                    ,symbol
+                    ,(package-outputs package)
+                    ,(->bool (member (%current-system)
+                                     (package-supported-systems package)))
+                    ,(->bool (package-superseded package))
+                    ,@(let ((loc (package-location package)))
+                        (if loc
+                            `(,(location-file loc)
+                              ,(location-line loc)
+                              ,(location-column loc))
+                            '(#f #f #f))))
+                 result)))
+      (_
+       result)))
+
+  (define exp
+    (fold-module-public-variables* expand-cache '()
+                                   (all-modules (%package-module-path)
+                                                #:warn
+                                                warn-about-load-error)))
+
+  (mkdir-p (dirname cache-file))
+  (call-with-output-file cache-file
+    (lambda (port)
+      ;; Store the cache as a '.go' file.  This makes loading fast and reduces
+      ;; heap usage since some of the static data is directly mmapped.
+      (put-bytevector port
+                      (compile `'(,@exp)
+                               #:to 'bytecode
+                               #:opts '(#:to-file? #t)))))
+  cache-file)
 
 
 (define %sigint-prompt
@@ -290,6 +465,30 @@ present, return the preferred newest version."
   (let-values (((name version) (package-name->name+version spec)))
     (%find-package spec name version)))
 
+(define (specification->location spec)
+  "Return the location of the highest-numbered package matching SPEC, a
+specification such as \"guile@2\" or \"emacs\"."
+  (let-values (((name version) (package-name->name+version spec)))
+    (match (find-package-locations name version)
+      (()
+       (if version
+           (leave (G_ "~A: package not found for version ~a~%") name version)
+           (leave (G_ "~A: unknown package~%") name)))
+      (lst
+       (let* ((highest   (match lst (((version . _) _ ...) version)))
+              (locations (take-while (match-lambda
+                                       ((version . location)
+                                        (string=? version highest)))
+                                     lst)))
+         (match locations
+           (((version . location) . rest)
+            (unless (null? rest)
+              (warning (G_ "ambiguous package specification `~a'~%") spec)
+              (warning (G_ "choosing ~a@~a from ~a~%")
+                       name version
+                       (location->string location)))
+            location)))))))
+
 (define* (specification->package+output spec #:optional (output "out"))
   "Return the package and output specified by SPEC, or #f and #f; SPEC may
 optionally contain a version number and an output name, as in these examples:
diff --git a/gnu/packages/ada.scm b/gnu/packages/ada.scm
index d60723edfa..a8c2bdc9a9 100644
--- a/gnu/packages/ada.scm
+++ b/gnu/packages/ada.scm
@@ -26,7 +26,8 @@
   #:use-module (gnu packages)
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
-  #:use-module (gnu packages python))
+  #:use-module (gnu packages python)
+  #:use-module (gnu packages python-xyz))
 
 (define-public python2-langkit
   (let ((commit "fe0bc8bf60dbd2937759810df76ac420d99fc15f")
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 5ad3f6d873..815ce19718 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -13,7 +13,7 @@
 ;;; Copyright © 2016 Peter Feigl <peter.feigl@nexoid.at>
 ;;; Copyright © 2016 John J. Foerch <jjfoerch@earthlink.net>
 ;;; Copyright © 2016, 2017 Nils Gillmann <ng0@n0.is>
-;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017 Ben Sturmfels <ben@sturm.com.au>
 ;;; Copyright © 2017 Ethan R. Jones <doubleplusgood23@gmail.com>
@@ -86,6 +86,7 @@
   #:use-module (gnu packages python)
   #:use-module (gnu packages python-crypto)
   #:use-module (gnu packages python-web)
+  #:use-module (gnu packages python-xyz)
   #:use-module (gnu packages qt)
   #:use-module (gnu packages terminals)
   #:use-module (gnu packages texinfo)
@@ -1510,7 +1511,7 @@ various ways that may be running with too much privilege.")
 (define-public smartmontools
   (package
     (name "smartmontools")
-    (version "6.6")
+    (version "7.0")
     (source (origin
               (method url-fetch)
               (uri (string-append
@@ -1518,7 +1519,7 @@ various ways that may be running with too much privilege.")
                     version "/smartmontools-" version ".tar.gz"))
               (sha256
                (base32
-                "0m1hllbb78rr6cxkbalmz1gqkl0psgq8rrmv4gwcmz34n07kvx2i"))))
+                "077nx2rn9szrg6isdh0938zbp7vr3dsyxl4jdyyzv1xwhqksrqg5"))))
     (build-system gnu-build-system)
     (inputs `(("libcap-ng" ,libcap-ng)))
     (home-page "https://www.smartmontools.org/")
diff --git a/gnu/packages/adns.scm b/gnu/packages/adns.scm
index 6e3af8b2d3..28a65667eb 100644
--- a/gnu/packages/adns.scm
+++ b/gnu/packages/adns.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016, 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
   #:use-module (guix licenses)
   #:use-module (guix packages)
   #:use-module (guix download)
+  #:use-module (guix build-system cmake)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages pkg-config))
 
@@ -80,3 +82,33 @@ queries without blocking, or need to perform multiple DNS queries in parallel.
 The primary examples of such applications are servers which communicate with
 multiple clients and programs with graphical user interfaces.")
     (license (x11-style "https://c-ares.haxx.se/license.html"))))
+
+;; XXX: temporary package for tensorflow / grpc
+(define-public c-ares-next
+  (package
+    (name "c-ares")
+    (version "1.15.0")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append
+                    "https://c-ares.haxx.se/download/" name "-" version
+                    ".tar.gz"))
+              (sha256
+               (base32
+                "0lk8knip4xk6qzksdkn7085mmgm4ixfczdyyjw656c193y3rgnvc"))))
+    (build-system cmake-build-system)
+    (arguments
+     `(#:tests? #f ; some tests seem to require Internet connection
+       #:configure-flags
+       (list "-DCARES_BUILD_TESTS=ON")))
+    (native-inputs
+     `(("pkg-config" ,pkg-config)))
+    (home-page "https://c-ares.haxx.se/")
+    (synopsis "C library for asynchronous DNS requests")
+    (description
+      "C-ares is a C library that performs DNS requests and name resolution
+asynchronously.  It is intended for applications which need to perform DNS
+queries without blocking, or need to perform multiple DNS queries in parallel.
+The primary examples of such applications are servers which communicate with
+multiple clients and programs with graphical user interfaces.")
+    (license (x11-style "https://c-ares.haxx.se/license.html"))))
diff --git a/gnu/packages/android.scm b/gnu/packages/android.scm
index 48380740a3..d5a60cb5bb 100644
--- a/gnu/packages/android.scm
+++ b/gnu/packages/android.scm
@@ -41,6 +41,7 @@
   #:use-module (gnu packages python)
   #:use-module (gnu packages python-crypto)
   #:use-module (gnu packages python-web)
+  #:use-module (gnu packages python-xyz)
   #:use-module (gnu packages selinux)
   #:use-module (gnu packages serialization)
   #:use-module (gnu packages ssh)
diff --git a/gnu/packages/animation.scm b/gnu/packages/animation.scm
index a10747ef38..965fff6d46 100644
--- a/gnu/packages/animation.scm
+++ b/gnu/packages/animation.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Pkill -9 <pkill9@runbox.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -258,3 +259,44 @@ easy to lip sync animated characters by making the process very simple – just
 type in the words being spoken, then drag the words on top of the sound’s
 waveform until they line up with the proper sounds.")
       (license license:gpl3+))))
+
+(define-public pencil2d
+  (package
+    (name "pencil2d")
+    (version "0.6.2")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/pencil2d/pencil")
+                    (commit (string-append "v" version))))
+              (file-name (git-file-name name version))
+              (sha256
+               (base32
+                "1iv7drwxs32mqs3hybjx2lxyqn8cv2b4rw9ny7gzdacsbhi65knr"))))
+    (build-system gnu-build-system)
+    (inputs
+     `(("qtbase" ,qtbase)
+       ("qtxmlpatterns" ,qtxmlpatterns)
+       ("qtmultimedia" ,qtmultimedia)
+       ("qtsvg" ,qtsvg)))
+    (arguments
+     `(#:phases
+       (modify-phases %standard-phases
+         (replace 'configure
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out")))
+               (invoke "qmake" (string-append "PREFIX=" out)))))
+         (add-after 'install 'wrap-executable
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((out (assoc-ref outputs "out"))
+                   (plugin-path (getenv "QT_PLUGIN_PATH")))
+               (wrap-program (string-append out "/bin/pencil2d")
+                 `("QT_PLUGIN_PATH" ":" prefix (,plugin-path)))
+               #t))))))
+    (home-page "https://www.pencil2d.org")
+    (synopsis "Make 2D hand-drawn animations")
+    (description
+     "Pencil2D is an easy-to-use and intuitive animation and drawing tool.  It
+lets you create traditional hand-drawn animations (cartoons) using both bitmap
+and vector graphics.")
+    (license license:gpl2)))
diff --git a/gnu/packages/apl.scm b/gnu/packages/apl.scm
index aa47edcd64..88150dc4d0 100644
--- a/gnu/packages/apl.scm
+++ b/gnu/packages/apl.scm
@@ -25,8 +25,8 @@
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages gettext)
   #:use-module (gnu packages maths)
-  #:use-module (gnu packages databases)
-  #:use-module (gnu packages readline))
+  #:use-module (gnu packages readline)
+  #:use-module (gnu packages sqlite))
 
 (define-public apl
   (package
diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm
index 80aacc5664..658f23e45d 100644
--- a/gnu/packages/audio.scm
+++ b/gnu/packages/audio.scm
@@ -8,7 +8,7 @@
 ;;; Copyright © 2016, 2017 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
 ;;; Copyright © 2016 Lukas Gradl <lgradl@openmailbox.org>
-;;; Copyright © 2016, 2017, 2018 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2016, 2017, 2018, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2018 okapi <okapi@firemail.cc>
 ;;; Copyright © 2018 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -18,6 +18,7 @@
 ;;; Copyright © 2018 Thorsten Wilms <t_w_@freenet.de>
 ;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2018 Brendan Tildesley <brendan.tildesley@openmailbox.org>
+;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,7 +58,7 @@
   #:use-module (gnu packages check)
   #:use-module (gnu packages compression)
   #:use-module (gnu packages curl)
-  #:use-module (gnu packages databases)
+  #:use-module (gnu packages dbm)
   #:use-module (gnu packages emacs)
   #:use-module (gnu packages file)
   #:use-module (gnu packages flex)
@@ -82,6 +83,7 @@
   #:use-module (gnu packages pkg-config)
   #:use-module (gnu packages pulseaudio)  ;libsndfile, libsamplerate
   #:use-module (gnu packages python)
+  #:use-module (gnu packages python-xyz)
   #:use-module (gnu packages rdf)
   #:use-module (gnu packages readline)
   #:use-module (gnu packages serialization)
@@ -761,7 +763,7 @@ emulation (valve, tape), bit fiddling (decimator, pointer-cast), etc.")
 (define-public csound
   (package
     (name "csound")
-    (version "6.11.0")
+    (version "6.12.0")
     (source (origin
               (method git-fetch)
               (uri (git-reference
@@ -770,7 +772,7 @@ emulation (valve, tape), bit fiddling (decimator, pointer-cast), etc.")
               (file-name (git-file-name name version))
               (sha256
                (base32
-                "1hlkrnv3gghx4v382nl6v6k2k1dzm5ddk35m5g3q6pzc959726s7"))))
+                "0pv4s54cayvavdp6y30n3r1l5x83x9whyyd2v24y0dh224v3hbxi"))))
     (build-system cmake-build-system)
     (inputs
      `(("alsa-lib" ,alsa-lib)
@@ -2154,7 +2156,11 @@ and ALSA.")
                 "1rzzqa39a6llr52vjkjr0a86nc776kmr5xs52qqga8ms9697psz5"))))
     (build-system gnu-build-system)
     (arguments
-     '(#:tests? #f))                    ; no check target
+     '(#:tests? #f ;; no check target
+       ;; Disable xunique to prevent X hanging when starting qjackctl in
+       ;; tiling window managers such as StumpWM or i3
+       ;; (see https://github.com/rncbc/qjackctl/issues/13).
+       #:configure-flags '("--disable-xunique")))
     (inputs
      `(("jack" ,jack-1)
        ("alsa-lib" ,alsa-lib)
diff --git a/gnu/packages/avahi.scm b/gnu/packages/avahi.scm
index df74437631..e71ffc2982 100644
--- a/gnu/packages/avahi.scm
+++ b/gnu/packages/avahi.scm
@@ -24,7 +24,7 @@
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages)
-  #:use-module (gnu packages databases)
+  #:use-module (gnu packages dbm)
   #:use-module (gnu packages libdaemon)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages pkg-config)
diff --git a/gnu/packages/backup.scm b/gnu/packages/backup.scm
index 4a8355f2b1..5d9013552e 100644
--- a/gnu/packages/backup.scm
+++ b/gnu/packages/backup.scm
@@ -46,6 +46,7 @@
   #:use-module (gnu packages compression)
   #:use-module (gnu packages crypto)
   #:use-module (gnu packages databases)
+  #:use-module (gnu packages dbm)
   #:use-module (gnu packages dejagnu)
   #:use-module (gnu packages ftp)
   #:use-module (gnu packages glib)
@@ -62,6 +63,7 @@
   #:use-module (gnu packages python)
   #:use-module (gnu packages python-crypto)
   #:use-module (gnu packages python-web)
+  #:use-module (gnu packages python-xyz)
   #:use-module (gnu packages rsync)
   #:use-module (gnu packages ssh)
   #:use-module (gnu packages tls)
diff --git a/gnu/packages/benchmark.scm b/gnu/packages/benchmark.scm
index 9d792021bd..e97e827cea 100644
--- a/gnu/packages/benchmark.scm
+++ b/gnu/packages/benchmark.scm
@@ -29,6 +29,7 @@
   #:use-module (gnu packages maths)
   #:use-module (gnu packages mpi)
   #:use-module (gnu packages python)
+  #:use-module (gnu packages python-xyz)
   #:use-module (gnu packages storage)
   #:use-module (ice-9 match))
 
diff --git a/gnu/packages/bioconductor.scm b/gnu/packages/bioconductor.scm
index 37ac94128b..20aabb0be4 100644
--- a/gnu/packages/bioconductor.scm
+++ b/gnu/packages/bioconductor.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2018 Roel Janssen <roel@gnu.org>
+;;; Copyright © 2017, 2018 Roel Janssen <roel@gnu.org>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -228,6 +228,53 @@ database is exposed as a @code{TxDb} object.")
     (license license:artistic2.0)))
 
 
+(define-public r-biocgenerics
+  (package
+    (name "r-biocgenerics")
+    (version "0.28.0")
+    (source (origin
+              (method url-fetch)
+              (uri (bioconductor-uri "BiocGenerics" version))
+              (sha256
+               (base32
+                "0cvpsrhg7sn7lpqgxvqrsagv6j7xj5rafq5xdjfd8zc4gxrs5rb8"))))
+    (properties
+     `((upstream-name . "BiocGenerics")))
+    (build-system r-build-system)
+    (home-page "https://bioconductor.org/packages/BiocGenerics")
+    (synopsis "S4 generic functions for Bioconductor")
+    (description
+     "This package provides S4 generic functions needed by many Bioconductor
+packages.")
+    (license license:artistic2.0)))
+
+(define-public r-annotate
+  (package
+    (name "r-annotate")
+    (version "1.60.0")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (bioconductor-uri "annotate" version))
+       (sha256
+        (base32
+         "0p6c96lay23a67dyirgnwzm2yw22m592z780vy6p4nqwla8ha18n"))))
+    (build-system r-build-system)
+    (propagated-inputs
+     `(("r-annotationdbi" ,r-annotationdbi)
+       ("r-biobase" ,r-biobase)
+       ("r-biocgenerics" ,r-biocgenerics)
+       ("r-dbi" ,r-dbi)
+       ("r-rcurl" ,r-rcurl)
+       ("r-xml" ,r-xml)
+       ("r-xtable" ,r-xtable)))
+    (home-page
+     "https://bioconductor.org/packages/annotate")
+    (synopsis "Annotation for microarrays")
+    (description "This package provides R environments for the annotation of
+microarrays.")
+    (license license:artistic2.0)))
+
 (define-public r-hpar
   (package
     (name "r-hpar")
diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm
index 42f5c3b80d..28dbdca13b 100644
--- a/gnu/packages/bioinformatics.scm
+++ b/gnu/packages/bioinformatics.scm
author	Tobias Geerinckx-Rice <me@tobias.gr>	2017-08-03 22:27:21 +0200
committer	Tobias Geerinckx-Rice <me@tobias.gr>	2017-08-04 01:51:22 +0200
commit	30ac4cc7e6a1819d4d56c02e695020498d7653d3 (patch)
tree	ca77cbfc41fbe04f0d627cd7f97ad0f5249e52bb /ChangeLog
parent	4de4a1cfccb981757765202a0fd2db4bf7479822 (diff)
download	guix-30ac4cc7e6a1819d4d56c02e695020498d7653d3.tar.gz guix-30ac4cc7e6a1819d4d56c02e695020498d7653d3.zip