[bug#74531] [PATCH] system: Add "installer" sub-command.

[<janneke@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 176 bytes --]

As suggested by Mathieu <https://issues.guix.gnu.org/73927#19>, this
patch adds the `guix system installer' subcommand.  The groundwork
was already there.

Greetigns,
Janneke


[-- Attachment #2: 0001-system-Add-installer-sub-command.patch --]
[-- Type: text/x-patch, Size: 7843 bytes --]

From c852c393ba77e702c7e57412ac031bca457d8602 Mon Sep 17 00:00:00 2001
Message-ID: <c852c393ba77e702c7e57412ac031bca457d8602.1732548624.git.janneke@gnu.org>
From: Janneke Nieuwenhuizen <janneke@gnu.org>
Date: Mon, 25 Nov 2024 16:17:33 +0100
Subject: [PATCH] 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                       |  8 ++++
 doc/guix.texi                     | 17 ++++++++
 gnu/installer.scm                 |  2 +-
 guix/scripts/system.scm           |  7 +++-
 guix/scripts/system/installer.scm | 70 +++++++++++++++++++++++++++++++
 5 files changed, 102 insertions(+), 2 deletions(-)
 create mode 100644 guix/scripts/system/installer.scm

diff --git a/Makefile.am b/Makefile.am
index e94ba87797..6812049e02 100644
--- a/Makefile.am
+++ b/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			\
diff --git a/doc/guix.texi b/doc/guix.texi
index 26488b41c8..d35bfccd06 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43196,6 +43196,23 @@ Invoking guix system
 @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
+creatiing of 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
+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
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 0a36f1f67b..4acad60f21 100644
--- a/gnu/installer.scm
+++ b/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)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7989b183ad..dd34f6cd15 100644
--- a/guix/scripts/system.scm
+++ b/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-command (guix-system . args)
     ;; 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)))
diff --git a/guix/scripts/system/installer.scm b/guix/scripts/system/installer.scm
new file mode 100644
index 0000000000..48baaefe42
--- /dev/null
+++ b/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))
+
+\f
+;;;
+;;; 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?))))

base-commit: 9b1fb12978482ffb6d37c456343f05609b28b3e8
-- 
2.46.0