gnu: r-tibble: Update to 3.0.0.
[jackhill/guix/guix.git] / gnu / installer.scm
index 1452c4d..50f5b1a 100644 (file)
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
   #:use-module (guix utils)
   #:use-module (guix ui)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (guix packages)
+  #:use-module (guix git-download)
+  #:use-module (gnu installer utils)
   #: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 file-systems)
   #:use-module (gnu packages guile)
   #:use-module (gnu packages guile-xyz)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
     (('guix 'build _ ...) #t)
     (_ #f)))
 
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix _ ...) #t)
+    (('gnu _ ...) #t)
+    (_ #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
@@ -69,9 +82,11 @@ version of this file."
         (setlocale LC_ALL "en_US.utf8")))
 
   (define builder
-    (with-extensions (list guile-json)
-      (with-imported-modules (source-module-closure
-                              '((gnu installer locale)))
+    (with-extensions (list guile-json-3)
+      (with-imported-modules `(,@(source-module-closure
+                                  '((gnu installer locale))
+                                  #:select? not-config?)
+                               ((guix config) => ,(make-config.scm)))
         #~(begin
             (use-modules (gnu installer locale))
 
@@ -226,15 +241,6 @@ selected keymap."
                      (#$keymap-step current-installer)))
           (configuration-formatter keyboard-layout->configuration))
 
-         ;; 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)
@@ -267,6 +273,17 @@ selected keymap."
                      ((installer-services-page current-installer))))
          (configuration-formatter system-services->configuration))
 
+         ;; Run a partitioning tool allowing the user to modify
+         ;; partition tables, partitions and their mount points.
+         ;; Do this last so the user has something to boot if any
+         ;; of the previous steps didn't go as expected.
+         (installer-step
+          (id 'partition)
+          (description (G_ "Partitioning"))
+          (compute (lambda _
+                     ((installer-partition-page current-installer))))
+          (configuration-formatter user-partitions->configuration))
+
         (installer-step
           (id 'final)
           (description (G_ "Configuration file"))
@@ -275,6 +292,25 @@ selected keymap."
              ((installer-final-page current-installer)
               result prev-steps))))))))
 
+(define guile-newt
+  ;; Guile-Newt with 'form-watch-fd'.
+  ;; TODO: Remove once a new release is out.
+  (let ((commit "b3c885d42cfac327d3531c9d064939514ce6bf12")
+        (revision "1"))
+    (package
+      (inherit (@ (gnu packages guile-xyz) guile-newt))
+      (name "guile-newt")
+      (version (git-version "0.0.1" revision commit))
+      (source  (origin
+                 (method git-fetch)
+                 (uri (git-reference
+                       (url "https://gitlab.com/mothacehe/guile-newt")
+                       (commit commit)))
+                 (file-name (git-file-name name version))
+                 (sha256
+                  (base32
+                   "02p0bi6c05699idgx6gfkljhqgi8zf09clhzx81i8wa064s70r1y")))))))
+
 (define (installer-program)
   "Return a file-like object that runs the given INSTALLER."
   (define init-gettext
@@ -292,7 +328,8 @@ selected keymap."
                                cryptsetup
                                dosfstools ;mkfs.fat
                                e2fsprogs ;mkfs.ext4
-                               btrfs-progs
+                               btrfs-progs ;mkfs.btrfs
+                               jfsutils ;jfs_mkfs
                                kbd ;chvt
                                guix ;guix system init call
                                util-linux ;mkwap
@@ -313,7 +350,7 @@ selected keymap."
     ;; packages …), etc. modules.
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
-                           guile-json guile-git guix)
+                           guile-json-3 guile-git guix)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
@@ -384,11 +421,14 @@ selected keymap."
                      ;; We did it!  Let's reboot!
                      (sync)
                      (stop-service 'root))
-                    (_                            ;installation failed
-                     ;; TODO: Honor the result of 'run-install-failed-page'.
+                    (_
+                     ;; The installation failed, exit so that it is restarted
+                     ;; by login.
                      #f)))
                 (const #f)
                 (lambda (key . args)
+                  (syslog "crashing due to uncaught exception: ~s ~s~%"
+                          key args)
                   (let ((error-file "/tmp/last-installer-error"))
                     (call-with-output-file error-file
                       (lambda (port)