Package: guix-patches;
Reported by: Lilah Tascheter <lilah <at> lunabee.space>
Date: Sun, 4 Aug 2024 03:52:01 UTC
Severity: normal
Tags: patch
Fix blocked by 73202: [PATCH] Preparation for bootloader rewrite.
View this message in rfc822 format
From: Herman Rimm <herman <at> rimm.ee> To: 72457 <at> debbugs.gnu.org Subject: [bug#72457] [PATCH v6 05/12] gnu: system: image: Reduce subprocedure indentation. Date: Tue, 24 Sep 2024 20:29:12 +0200
* gnu/system/image.scm (system-disk-image): Reduce indentation.
Change-Id: I9cf59d3a61d0c6e7e90009e62661f74f774f090a
---
gnu/system/image.scm | 115 ++++++++++++++++++++++---------------------
1 file changed, 59 insertions(+), 56 deletions(-)
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b58de1db14..6201b36334 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -448,63 +448,66 @@ (define* (system-disk-image image
(format #f (G_ "unsupported partition type: ~a")
file-system)))))))))
+ (define (image-builder partition)
+ "A directory, filled by calling the PARTITION initializer
+procedure, is first created within the store. Then, an image of this
+directory is created using tools such as 'mke2fs' or 'mkdosfs',
+depending on the partition file-system type."
+ (let ((os (image-operating-system image))
+ (schema (local-file (search-path %load-path
+ "guix/store/schema.sql")))
+ (graph (match inputs
+ (((names . _) ...)
+ names)))
+ (type (partition-file-system partition)))
+ (with-imported-modules*
+ (let ((initializer (or #$(partition-initializer partition)
+ initialize-root-partition))
+ (inputs '#+(cond
+ ((string-prefix? "ext" type)
+ (list e2fsprogs fakeroot))
+ ((or (string=? type "vfat")
+ (string-prefix? "fat" type))
+ (list dosfstools fakeroot mtools))
+ (else
+ '())))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
+ (sql-schema #$schema)
+
+ (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
+
+ ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
+ ;; decoded.
+ (setenv "GUIX_LOCPATH"
+ #+(file-append (libc-utf8-locales-for-target
+ (%current-system))
+ "/lib/locale"))
+ (setlocale LC_ALL "en_US.utf8")
+
+ (initializer image-root
+ #:references-graphs '#$graph
+ #:deduplicate? #f
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; There's no point installing a bootloader if we do not
+ ;; populate the store.
+ (when copy-closures?
+ ;; Root-offset isn't necessary: we override 'root.
+ #$(bootloader-configurations->gexp
+ bootloader-config bootmeta
+ #:overrides (targets partition)))
+ (make-partition-image #$(partition->gexp partition)
+ #$output
+ image-root)))))
+
(define (partition-image partition)
- ;; Return as a file-like object, an image of the given PARTITION. A
- ;; directory, filled by calling the PARTITION initializer procedure, is
- ;; first created within the store. Then, an image of this directory is
- ;; created using tools such as 'mke2fs' or 'mkdosfs', depending on the
- ;; partition file-system type.
- (let* ((os (image-operating-system image))
- (schema (local-file (search-path %load-path
- "guix/store/schema.sql")))
- (graph (match inputs
- (((names . _) ...)
- names)))
- (type (partition-file-system partition))
- (image-builder
- (with-imported-modules*
- (let ((initializer (or #$(partition-initializer partition)
- initialize-root-partition))
- (inputs '#+(cond
- ((string-prefix? "ext" type)
- (list e2fsprogs fakeroot))
- ((or (string=? type "vfat")
- (string-prefix? "fat" type))
- (list dosfstools fakeroot mtools))
- (else
- '())))
- (image-root (string-append (getcwd) "/tmp-root"))
- (copy-closures? (not #$(image-shared-store? image))))
- (sql-schema #$schema)
-
- (set-path-environment-variable "PATH" '("bin" "sbin") inputs)
-
- ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be
- ;; decoded.
- (setenv "GUIX_LOCPATH"
- #+(file-append (libc-utf8-locales-for-target
- (%current-system))
- "/lib/locale"))
- (setlocale LC_ALL "en_US.utf8")
-
- (initializer image-root
- #:references-graphs '#$graph
- #:deduplicate? #f
- #:copy-closures? copy-closures?
- #:system-directory #$os)
- ;; no point installing a bootloader if we don't populate store
- (when copy-closures?
- ;; root-offset isn't necessary - we override 'root
- #$(bootloader-configurations->gexp bootloader-config bootmeta
- #:overrides (targets partition)))
- (make-partition-image #$(partition->gexp partition)
- #$output
- image-root)))))
- (computed-file "partition.img" image-builder
- ;; Allow offloading so that this I/O-intensive process
- ;; doesn't run on the build farm's head node.
- #:local-build? #f
- #:options `(#:references-graphs ,inputs))))
+ "Return as a file-like object, an image of the given PARTITION."
+ (computed-file "partition.img" (image-builder partition)
+ ;; Allow offloading so that this I/O-intensive process
+ ;; doesn't run on the build farm's head node.
+ #:local-build? #f
+ #:options `(#:references-graphs ,inputs)))
(define (gpt-image? image)
(eq? 'gpt (image-partition-table-type image)))
--
2.45.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.