system: Add "installer" sub-command.

* guix/scripts/system/installer.scm: New file.
* Makefile.am (MODULES)[ENABLE_INSTALLER]: Register it.
(MODULES_NOT_COMPILED)[!ENABLE_INSTALLER]: Likewise.
* guix/scripts/system.scm (show-help): Add help for "installer" sub-command.
(actions): Register "installer".
(guix-system): Invoke `guix-system-installer' sub-command.
* doc/guix.texi (Invoking guix system): Document it.
* gnu/installer.scm (run-installer): Remove "./pre-inst env".

Change-Id: I5a05b941c060682c17d45d871df3cf34e3f8643a

Makefile.am

@@ -408,6 +408,14 @@ MODULES +=					\
 
 endif BUILD_DAEMON_OFFLOAD
 
+INSTALLER_SCRIPT = guix/scripts/system/installer.scm
+
+if ENABLE_INSTALLER
+MODULES += $(INSTALLER_SCRIPT)
+else
+MODULES_NOT_COMPILED += $(INSTALLER_SCRIPT)
+endif !ENABLE_INSTALLER
+
 # Scheme implementation of the build daemon and related functionality.
 STORE_MODULES =					\
   guix/store/database.scm			\

doc/guix.texi

@@ -43258,6 +43258,23 @@ This command also installs bootloader on the targets specified in
 @file{my-os-config}, unless the @option{--no-bootloader} option was
 passed.
 
+@item installer
+Run the installer.  Usually the installer is built as an @file{iso}
+image, copied to a USB Stick or DVD, and booted from (@ref{USB Stick and
+DVD Installation}).  If your machine already runs Guix and you still
+want to run the installer, e.g., for testing purposes, you can skip the
+step of creating an @file{iso} and run for instance:
+
+@example
+guix system installer --dry-run
+@end example
+
+@quotation Note
+If you do not use @option{--dry-run} then you need to run as root.  Be
+@emph{very careful} when running the installer as root, it can cause
+data loss or render your system unbootable!
+@end quotation
+
 @item vm
 @cindex virtual machine
 @cindex VM

gnu/installer.scm

@@ -642,4 +642,4 @@ (define* (run-installer #:key dry-run?)
          (outputs (build-derivations store (list drv))))
     (close-connection store)
     (format #t "running installer: ~a\n" program)
-    (invoke "./pre-inst-env" "guile" program)))
+    (invoke "guile" program)))

guix/scripts/system.scm

@@ -56,6 +56,7 @@ (define-module (guix scripts system)
                                        delete-matching-generations
                                        list-installed)
   #:autoload   (guix scripts pull) (channel-commit-hyperlink)
+  #:autoload   (guix scripts system installer) (guix-system-installer)
   #:autoload   (guix graph) (export-graph node-type
                              graph-backend-name lookup-backend)
   #:use-module (guix scripts system reconfigure)
@@ -996,6 +997,8 @@ (define (show-help)
    docker-image     build a Docker image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
+  (display (G_ "\
+   installer        run the graphical installer\n"))
   (display (G_ "\
    extension-graph  emit the service extension graph in Dot format\n"))
   (display (G_ "\
@@ -1229,7 +1232,7 @@ (define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
                   "list-generations" "describe"
                   "delete-generations" "roll-back"
                   "switch-generation" "search" "edit"
-                  "docker-image"))
+                  "docker-image" "installer"))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -1441,6 +1444,8 @@ (define (parse-sub-command arg result)
     ;; Parse sub-command ARG and augment RESULT accordingly.
     (cond ((assoc-ref result 'action)
            (alist-cons 'argument arg result))
+          ((equal? arg "installer")
+           (apply guix-system-installer args))
           ((member arg actions)
            (let ((action (string->symbol arg)))
              (alist-cons 'action action result)))

guix/scripts/system/installer.scm

@@ -0,0 +1,70 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; 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 (guix scripts system installer)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-37)
+  #:use-module (gnu installer)
+  #:use-module (guix scripts)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:export (guix-system-installer))
+
+;;; Commentary:
+;;;
+;;; Implement the 'guix system installer' command, which runs the installer,
+;;; directly as a Guix command, also in dry-run mode.
+;;;
+;;; Code:
+
+(define %options
+  (list (option '(#\n "dry-run") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'dry-run? #t result)))
+        (option '(#\h "help") #f #f
+                (lambda args
+                  (show-help)
+                  (exit 0)))
+        (option '(#\V "version") #f #f
+                (lambda args
+                  (show-version-and-exit "guix system installer")))))
+
+(define (show-help)
+  (display (G_ "Usage: guix system installer [OPTION]...
+Run the system installler.\n"))
+  (display (G_ "
+  -n, --dry-run          skip network setup, partitioning, and actual install"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+
+;;;
+;;; Entry Point.
+;;;
+(define-command (guix-system-installer . args)
+  (synopsis "run the graphical installer program")
+
+  (with-error-handling
+    (let* ((opts     (parse-command-line args %options '((dry-run? . #f))
+                                         #:build-options? #f))
+           (dry-run? (assoc-ref opts 'dry-run?)))
+      (run-installer #:dry-run? dry-run?))))