summaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-10-12 16:50:47 +0000
committerMathieu Othacehe <othacehe@gnu.org>2021-10-12 17:46:23 +0000
commita1eca979fb8da842e73c42f4f53be29b169810f2 (patch)
tree681c7283e412bb8a29c2531c4408b49c3e184764 /gnu/system
parent48d86a9ec6d8d2e97da2299ea41a03ef4cdaab83 (diff)
parent371aa5777a3805a3886f3feea5f1960fe3fe4219 (diff)
Merge remote-tracking branch 'origin/master' into core-updates-frozen.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/file-systems.scm20
-rw-r--r--gnu/system/image.scm51
-rw-r--r--gnu/system/images/hurd.scm8
-rw-r--r--gnu/system/images/novena.scm6
-rw-r--r--gnu/system/images/pine64.scm6
-rw-r--r--gnu/system/images/pinebook-pro.scm6
-rw-r--r--gnu/system/images/rock64.scm8
-rw-r--r--gnu/system/linux-initrd.scm19
-rw-r--r--gnu/system/uuid.scm9
9 files changed, 94 insertions, 39 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index b9eda80958..e69cfd06e6 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2020 Google LLC
;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -51,6 +52,8 @@
file-system-mount?
file-system-mount-may-fail?
file-system-check?
+ file-system-skip-check-if-clean?
+ file-system-repair
file-system-create-mount-point?
file-system-dependencies
file-system-location
@@ -123,6 +126,10 @@
(default #f))
(check? file-system-check? ; Boolean
(default #t))
+ (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean
+ (default #t))
+ (repair file-system-repair ; symbol or #f
+ (default 'preen))
(create-mount-point? file-system-create-mount-point? ; Boolean
(default #f))
(dependencies file-system-dependencies ; list of <file-system>
@@ -318,19 +325,22 @@ store--e.g., if FS is the root file system."
initrd code."
(match fs
(($ <file-system> device mount-point type flags options mount?
- mount-may-fail? needed-for-boot? check?)
+ mount-may-fail? needed-for-boot?
+ check? skip-check-if-clean? repair)
;; Note: Add new fields towards the end for compatibility.
(list (cond ((uuid? device)
`(uuid ,(uuid-type device) ,(uuid-bytevector device)))
((file-system-label? device)
`(file-system-label ,(file-system-label->string device)))
(else device))
- mount-point type flags options mount-may-fail? check?))))
+ mount-point type flags options mount-may-fail?
+ check? skip-check-if-clean? repair))))
(define (spec->file-system sexp)
"Deserialize SEXP, a list, to the corresponding <file-system> object."
(match sexp
- ((device mount-point type flags options mount-may-fail? check?
+ ((device mount-point type flags options mount-may-fail?
+ check? skip-check-if-clean? repair
_ ...) ;placeholder for new fields
(file-system
(device (match device
@@ -343,7 +353,9 @@ initrd code."
(mount-point mount-point) (type type)
(flags flags) (options options)
(mount-may-fail? mount-may-fail?)
- (check? check?)))))
+ (check? check?)
+ (skip-check-if-clean? skip-check-if-clean?)
+ (repair repair)))))
(define (specification->file-system-mapping spec writable?)
"Read the SPEC and return the corresponding <file-system-mapping>. SPEC is
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 1012fa6158..7a807b8226 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -31,6 +31,7 @@
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu image)
+ #:use-module (gnu platform)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system)
@@ -66,16 +67,14 @@
efi-disk-image
iso9660-image
- arm32-disk-image
- arm64-disk-image
+ raw-with-offset-disk-image
image-with-os
efi-raw-image-type
qcow2-image-type
iso-image-type
uncompressed-iso-image-type
- arm32-image-type
- arm64-image-type
+ raw-with-offset-image-type
image-with-label
system-image
@@ -128,10 +127,9 @@
(label "GUIX_IMAGE")
(flags '(boot)))))))
-(define* (arm32-disk-image #:optional (offset root-offset))
+(define* (raw-with-offset-disk-image #:optional (offset root-offset))
(image
(format 'disk-image)
- (target "arm-linux-gnueabihf")
(partitions
(list (partition
(inherit root-partition)
@@ -140,11 +138,6 @@
;; fails.
(volatile-root? #f)))
-(define* (arm64-disk-image #:optional (offset root-offset))
- (image
- (inherit (arm32-disk-image offset))
- (target "aarch64-linux-gnu")))
-
;;;
;;; Images types.
@@ -186,15 +179,10 @@ set to the given OS."
(compression? #f))
<>))))
-(define arm32-image-type
- (image-type
- (name 'arm32-raw)
- (constructor (cut image-with-os (arm32-disk-image) <>))))
-
-(define arm64-image-type
+(define raw-with-offset-image-type
(image-type
- (name 'arm64-raw)
- (constructor (cut image-with-os (arm64-disk-image) <>))))
+ (name 'raw-with-offset)
+ (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
;;
@@ -615,7 +603,30 @@ it can be used for bootloading."
"Return the derivation of IMAGE. It can be a raw disk-image or an ISO9660
image, depending on IMAGE format."
(define substitutable? (image-substitutable? image))
- (define target (image-target image))
+ (define platform (image-platform image))
+
+ ;; The image platform definition may provide the appropriate "system"
+ ;; architecture for the image. If we are already running on this system,
+ ;; the image can be built natively. If we are running on a different
+ ;; system, then we need to cross-compile, using the "target" provided by the
+ ;; image definition.
+ (define system (and=> platform platform-system))
+ (define target (cond
+ ;; No defined platform, let's use the user defined
+ ;; system/target parameters.
+ ((not platform)
+ (%current-target-system))
+ ;; The current system is the same as the platform system, no
+ ;; need to cross-compile.
+ ((and system
+ (string=? system (%current-system)))
+ #f)
+ ;; If there is a user defined target let's override the
+ ;; platform target. Otherwise, we can cross-compile to the
+ ;; platform target.
+ (else
+ (or (%current-target-system)
+ (and=> platform platform-target)))))
(with-parameters ((%current-target-system target))
(let* ((os (operating-system-for-image image))
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index fc2dbe3209..77f7ff5e2b 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -23,6 +23,7 @@
#:use-module (gnu bootloader grub)
#:use-module (gnu image)
#:use-module (gnu packages ssh)
+ #:use-module (gnu platforms hurd)
#:use-module (gnu services)
#:use-module (gnu services ssh)
#:use-module (gnu system)
@@ -75,7 +76,6 @@
(define hurd-disk-image
(image
(format 'disk-image)
- (target "i586-pc-gnu")
(partitions
(list (partition
(size 'guess)
@@ -103,13 +103,15 @@
(define hurd-barebones-disk-image
(image
(inherit
- (os->image hurd-barebones-os #:type hurd-image-type))
+ (os+platform->image hurd-barebones-os hurd
+ #:type hurd-image-type))
(name 'hurd-barebones-disk-image)))
(define hurd-barebones-qcow2-image
(image
(inherit
- (os->image hurd-barebones-os #:type hurd-qcow2-image-type))
+ (os+platform->image hurd-barebones-os hurd
+ #:type hurd-qcow2-image-type))
(name 'hurd-barebones.qcow2)))
;; Return the default image.
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 63227af509..3ce62fbf3b 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -22,6 +22,7 @@
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages linux)
+ #:use-module (gnu platforms arm)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system)
@@ -52,12 +53,13 @@
(define novena-image-type
(image-type
(name 'novena-raw)
- (constructor (cut image-with-os (arm32-disk-image) <>))))
+ (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
(define novena-barebones-raw-image
(image
(inherit
- (os->image novena-barebones-os #:type novena-image-type))
+ (os+platform->image novena-barebones-os armv7-linux
+ #:type novena-image-type))
(name 'novena-barebones-raw-image)))
;; Return the default image.
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 808c71295f..aaec458766 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -21,6 +21,7 @@
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages linux)
+ #:use-module (gnu platforms arm)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system)
@@ -57,12 +58,13 @@
(define pine64-image-type
(image-type
(name 'pine64-raw)
- (constructor (cut image-with-os (arm64-disk-image) <>))))
+ (constructor (cut image-with-os (raw-with-offset-disk-image) <>))))
(define pine64-barebones-raw-image
(image
(inherit
- (os->image pine64-barebones-os #:type pine64-image-type))
+ (os+platform->image pine64-barebones-os aarch64-linux
+ #:type pine64-image-type))
(name 'pine64-barebones-raw-image)))
;; Return the default image.
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index b6b844cef6..1bfac7a8bb 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -21,6 +21,7 @@
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages linux)
+ #:use-module (gnu platforms arm)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu system)
@@ -58,13 +59,14 @@
(image-type
(name 'pinebook-pro-raw)
(constructor (cut image-with-os
- (arm64-disk-image (* 9 (expt 2 20))) ;9MiB
+ (raw-with-offset-disk-image (* 9 (expt 2 20))) ;9MiB
<>))))
(define pinebook-pro-barebones-raw-image
(image
(inherit
- (os->image pinebook-pro-barebones-os #:type pinebook-pro-image-type))
+ (os+platform->image pinebook-pro-barebones-os aarch64-linux
+ #:type pinebook-pro-image-type))
(name 'pinebook-pro-barebones-raw-image)))
;; Return the default image.
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index 68d3742adc..d25d55e528 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -21,6 +21,7 @@
#:use-module (gnu bootloader u-boot)
#:use-module (gnu image)
#:use-module (gnu packages linux)
+ #:use-module (gnu platforms arm)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services networking)
@@ -53,12 +54,15 @@
(define rock64-image-type
(image-type
(name 'rock64-raw)
- (constructor (cut image-with-os (arm64-disk-image (expt 2 24)) <>))))
+ (constructor (cut image-with-os
+ (raw-with-offset-disk-image (expt 2 24))
+ <>))))
(define rock64-barebones-raw-image
(image
(inherit
- (os->image rock64-barebones-os #:type rock64-image-type))
+ (os+platform->image rock64-barebones-os aarch64-linux
+ #:type rock64-image-type))
(name 'rock64-barebones-raw-image)))
rock64-barebones-raw-image
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 8c245b8445..a083292fcf 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -210,6 +210,16 @@ upon error."
(open source targets)))
mapped-devices))
+ (define file-system-scan-commands
+ ;; File systems like btrfs need help to assemble multi-device file systems
+ ;; but do not use manually-specified <mapped-devices>.
+ (let ((file-system-types (map file-system-type file-systems)))
+ (if (member "btrfs" file-system-types)
+ ;; Ignore errors: if the system manages to boot anyway, the better.
+ #~((system* (string-append #$btrfs-progs/static "/bin/btrfs")
+ "device" "scan"))
+ #~())))
+
(define kodir
(flat-linux-module-directory linux linux-modules))
@@ -245,7 +255,8 @@ upon error."
(map spec->file-system
'#$(map file-system->spec file-systems))
#:pre-mount (lambda ()
- (and #$@device-mapping-commands))
+ (and #$@device-mapping-commands
+ #$@file-system-scan-commands))
#:linux-modules '#$linux-modules
#:linux-module-directory '#$kodir
#:keymap-file #+(and=> keyboard-layout
@@ -269,7 +280,7 @@ FILE-SYSTEMS."
(list fatfsck/static)
'())
,@(if (find (file-system-type-predicate "bcachefs") file-systems)
- (list bcachefs-tools/static)
+ (list bcachefs/static)
'())
,@(if (find (file-system-type-predicate "btrfs") file-systems)
(list btrfs-progs/static)
@@ -279,6 +290,9 @@ FILE-SYSTEMS."
'())
,@(if (find (file-system-type-predicate "f2fs") file-systems)
(list f2fs-fsck/static)
+ '())
+ ,@(if (find (file-system-type-predicate "xfs") file-systems)
+ (list xfs_repair/static)
'())))
(define-syntax vhash ;TODO: factorize
@@ -311,6 +325,7 @@ FILE-SYSTEMS."
("iso9660" => '("isofs"))
("jfs" => '("jfs"))
("f2fs" => '("f2fs" "crc32_generic"))
+ ("xfs" => '("xfs"))
(else '())))
(define (file-system-modules file-systems)
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index f4c4be6e2b..a95dc1b7d1 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -47,6 +47,7 @@
string->fat-uuid
string->jfs-uuid
string->ntfs-uuid
+ string->xfs-uuid
iso9660-uuid->string
;; XXX: For lack of a better place.
@@ -239,7 +240,9 @@ ISO9660 UUID representation."
(define string->ext4-uuid string->dce-uuid)
(define string->bcachefs-uuid string->dce-uuid)
(define string->btrfs-uuid string->dce-uuid)
+(define string->f2fs-uuid string->dce-uuid)
(define string->jfs-uuid string->dce-uuid)
+(define string->xfs-uuid string->dce-uuid)
(define-syntax vhashq
(syntax-rules (=>)
@@ -253,14 +256,16 @@ ISO9660 UUID representation."
(define %uuid-parsers
(vhashq
- ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => string->dce-uuid)
+ ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks
+ => string->dce-uuid)
('fat32 'fat16 'fat => string->fat-uuid)
('ntfs => string->ntfs-uuid)
('iso9660 => string->iso9660-uuid)))
(define %uuid-printers
(vhashq
- ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => dce-uuid->string)
+ ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks
+ => dce-uuid->string)
('iso9660 => iso9660-uuid->string)
('fat32 'fat16 'fat => fat-uuid->string)
('ntfs => ntfs-uuid->string)))