ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: system: image: Reduce subprocedure indentation.

Browse source 
* gnu/system/image.scm (system-disk-image): Reduce indentation.

Change-Id: I9cf59d3a61d0c6e7e90009e62661f74f774f090a
This commit is contained in:
Herman Rimm 2024-09-23 11:13:08 +02:00 committed by Ryan Schanzenbacher
parent 689cca0c75
commit a95413d299
Signed by: ryan77627
GPG key ID: 81B0E222A3E2308E
1 changed files with 59 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

115
gnu/system/image.scm
View file

@ -448,63 +448,66 @@ (define (partition->gpt-type partition)
(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)))