From 602994847b748937b6fa39a7b819429857cdd8d3 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Sat, 15 May 2021 15:29:40 +0200 Subject: file-systems: Support forced checks & repairs. * gnu/build/file-systems.scm (check-ext2-file-system) (check-bcachefs-file-system, check-btrfs-file-system) (check-fat-file-system, check-jfs-file-system, check-f2fs-file-system) (check-ntfs-file-system, check-file-system): Take and honour new FORCE? and REPAIR arguments. Update the docstring. Adjust all callers. * gnu/system/file-systems.scm : Add new SKIP-CHECK-IF-CLEAN? and REPAIR fields. (file-system->spec, spec->file-system): Adjust accordingly. * gnu/build/linux-boot.scm (mount-root-file-system): Take new SKIP-CHECK-IF-CLEAN? and REPAIR keyword arguments. Thread them through to CHECK-FILE-SYSTEM. * doc/guix.texi (File Systems): Document both new options. --- gnu/system/file-systems.scm | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'gnu/system') diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index b9eda80958..0350bf984f 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 ;;; Copyright © 2020, 2021 Maxim Cournoyer +;;; Copyright © 2021 Tobias Geerinckx-Rice ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,6 +52,8 @@ (define-module (gnu system file-systems) 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 @@ (define-record-type* %file-system (default #f)) (check? file-system-check? ; Boolean (default #t)) + (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean + (default #f)) + (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 @@ -318,19 +325,22 @@ (define (file-system->spec fs) initrd code." (match fs (($ 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 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 @@ (define (spec->file-system sexp) (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 . SPEC is -- cgit v1.2.3 From 68b219b9f482f09e7c55aaee4b64222d8c86172a Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Sat, 12 Jun 2021 21:36:08 +0200 Subject: gnu: Don't abuse check-btrfs-file-system to scan. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It was never guaranteed to be run for non-root file systems. It was for root file systems only due to a bug now fixed. * gnu/build/file-systems.scm (check-btrfs-file-system): Don't invoke ‘btrfs device scan’ here. * gnu/system/linux-initrd.scm (raw-initrd): Do so here if any btrfs file systems are present. --- gnu/build/file-systems.scm | 2 -- gnu/system/linux-initrd.scm | 13 ++++++++++++- 2 files changed, 12 insertions(+), 3 deletions(-) (limited to 'gnu/system') diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index a54127e888..251ca51fc4 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -328,8 +328,6 @@ (define (check-btrfs-file-system device force? repair) @uref{https://bugzilla.redhat.com/show_bug.cgi?id=625967#c8}. If REPAIR is false, do not write to DEVICE. If it's #t, fix any errors found. Otherwise, fix only those considered safe to repair automatically." - ;; XXX Why make this conditional on (check? #t) at all? - (system* "btrfs" "device" "scan") ; ignore errors (if force? (match (status:exit-val (apply system* `("btrfs" "check" "--progress" diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 8c245b8445..7f7740dd6e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -210,6 +210,16 @@ (define device-mapping-commands (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 . + (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 @@ (define kodir (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 -- cgit v1.2.3 From 15489291d93bcd67e30eed686da0d58050ce1c0e Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Wed, 22 Sep 2021 23:46:26 +0200 Subject: linux-initrd: Include only the single ‘bcachefs’ binary. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/system/linux-initrd.scm (file-system-packages): Substitute bcachefs/static for bcachefs-tools/static. --- gnu/system/linux-initrd.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/system') diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 7f7740dd6e..dc0f419bfd 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -280,7 +280,7 @@ (define* (file-system-packages file-systems #:key (volatile-root? #f)) (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) -- cgit v1.2.3 From 90604348e14913da48327da05113d7da8ae7655a Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 23 Sep 2021 13:16:39 +0200 Subject: uuid: Support XFS. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/system/uuid.scm (string->xfs-uuid): New procedure. (%uuid-parsers, %uuid-printers): Add ‘xfs’ file system type. --- gnu/system/uuid.scm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'gnu/system') 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 @@ (define-module (gnu system uuid) 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 @@ (define string->ext3-uuid string->dce-uuid) (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 @@ (define-syntax vhashq (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))) -- cgit v1.2.3 From cd19c920b7bf15af6b8ea06aa5021487d65773a6 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 23 Sep 2021 13:14:52 +0200 Subject: linux-initrd: Support XFS. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/system/linux-initrd.scm (file-system-packages): Add xfs_repair/static when needed. (file-system-type-modules): Add ‘xfs’ module when needed. --- gnu/system/linux-initrd.scm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'gnu/system') diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index dc0f419bfd..a083292fcf 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -290,6 +290,9 @@ (define* (file-system-packages file-systems #:key (volatile-root? #f)) '()) ,@(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 @@ -322,6 +325,7 @@ (define file-system-type-modules ("iso9660" => '("isofs")) ("jfs" => '("jfs")) ("f2fs" => '("f2fs" "crc32_generic")) + ("xfs" => '("xfs")) (else '()))) (define (file-system-modules file-systems) -- cgit v1.2.3 From 69f37702dfcda776a190d5c40fad8518469ce3c4 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Fri, 24 Sep 2021 21:08:13 +0200 Subject: file-systems: Fix skip-check-if-clean? default. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Let this be a warning against—even cautiously and deliberately—using double negatives. You shall stare, but you shall not see. * gnu/system/file-systems.scm (): Fix the default skip-check-if-clean? value to match the documentation and the intention. --- gnu/system/file-systems.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/system') diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 0350bf984f..e69cfd06e6 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -127,7 +127,7 @@ (define-record-type* %file-system (check? file-system-check? ; Boolean (default #t)) (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean - (default #f)) + (default #t)) (repair file-system-repair ; symbol or #f (default 'preen)) (create-mount-point? file-system-create-mount-point? ; Boolean -- cgit v1.2.3 From d5073fd113c621fe0b55382f7dd336ee118e759f Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 30 Aug 2021 18:24:27 +0200 Subject: gnu: Add platform support. * gnu/platform.scm: New file. * gnu/platforms/arm.scm: Ditto. * gnu/platforms/hurd.scm: Ditto. * gnu/local.mk (GNU_SYSTEM_MODULES): Add them. Signed-off-by: Mathieu Othacehe --- gnu/image.scm | 13 +++++++--- gnu/local.mk | 4 +++ gnu/platform.scm | 38 ++++++++++++++++++++++++++++ gnu/platforms/arm.scm | 36 +++++++++++++++++++++++++++ gnu/platforms/hurd.scm | 28 +++++++++++++++++++++ gnu/system/image.scm | 51 +++++++++++++++++++++++--------------- gnu/system/images/hurd.scm | 8 +++--- gnu/system/images/novena.scm | 6 +++-- gnu/system/images/pine64.scm | 6 +++-- gnu/system/images/pinebook-pro.scm | 6 +++-- gnu/system/images/rock64.scm | 8 ++++-- guix/scripts/system.scm | 5 ++-- 12 files changed, 172 insertions(+), 37 deletions(-) create mode 100644 gnu/platform.scm create mode 100644 gnu/platforms/arm.scm create mode 100644 gnu/platforms/hurd.scm (limited to 'gnu/system') diff --git a/gnu/image.scm b/gnu/image.scm index 75d489490d..2381efa208 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu image) + #:use-module (gnu platform) #:use-module (guix records) #:export (partition partition? @@ -34,7 +35,7 @@ (define-module (gnu image) image? image-name image-format - image-target + image-platform image-size image-operating-system image-partitions @@ -47,7 +48,8 @@ (define-module (gnu image) image-type-name image-type-constructor - os->image)) + os->image + os+platform->image)) ;;; @@ -78,7 +80,7 @@ (define-record-type* (name image-name ;symbol (default #f)) (format image-format) ;symbol - (target image-target + (platform image-platform ; (default #f)) (size image-size ;size in bytes as integer (default 'guess)) @@ -112,3 +114,8 @@ (define-record-type* (define* (os->image os #:key type) (let ((constructor (image-type-constructor type))) (constructor os))) + +(define* (os+platform->image os platform #:key type) + (image + (inherit (os->image os #:type type)) + (platform platform))) diff --git a/gnu/local.mk b/gnu/local.mk index 63ef645deb..502f198c5e 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -83,6 +83,7 @@ GNU_SYSTEM_MODULES = \ %D%/home/services/utils.scm \ %D%/home/services/xdg.scm \ %D%/image.scm \ + %D%/platform.scm \ %D%/packages.scm \ %D%/packages/abduco.scm \ %D%/packages/abiword.scm \ @@ -612,6 +613,9 @@ GNU_SYSTEM_MODULES = \ %D%/packages/zile.scm \ %D%/packages/zwave.scm \ \ + %D%/platforms/arm.scm \ + %D%/platforms/hurd.scm \ + \ %D%/services.scm \ %D%/services/admin.scm \ %D%/services/audio.scm \ diff --git a/gnu/platform.scm b/gnu/platform.scm new file mode 100644 index 0000000000..bb6519c71a --- /dev/null +++ b/gnu/platform.scm @@ -0,0 +1,38 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu platform) + #:use-module (guix records) + #:export (platform + platform? + platform-target + platform-system + platform-linux-architecture)) + + +;;; +;;; Platform record. +;;; + +;; Description of a platform supported by the GNU system. +(define-record-type* platform make-platform + platform? + (target platform-target) ;"x86_64-linux-gnu" + (system platform-system) ;"x86_64-linux" + (linux-architecture platform-linux-architecture ;"amd64" + (default #f))) diff --git a/gnu/platforms/arm.scm b/gnu/platforms/arm.scm new file mode 100644 index 0000000000..1e61741a35 --- /dev/null +++ b/gnu/platforms/arm.scm @@ -0,0 +1,36 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu platforms arm) + #:use-module (gnu platform) + #:use-module (gnu packages linux) + #:use-module (guix records) + #:export (armv7-linux + aarch64-linux)) + +(define armv7-linux + (platform + (target "arm-linux-gnueabihf") + (system "armhf-linux") + (linux-architecture "arm"))) + +(define aarch64-linux + (platform + (target "aarch64-linux-gnu") + (system "aarch64-linux") + (linux-architecture "arm64"))) diff --git a/gnu/platforms/hurd.scm b/gnu/platforms/hurd.scm new file mode 100644 index 0000000000..0e5c58fd08 --- /dev/null +++ b/gnu/platforms/hurd.scm @@ -0,0 +1,28 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu platforms hurd) + #:use-module (gnu platform) + #:use-module (gnu packages linux) + #:use-module (guix records) + #:export (hurd)) + +(define hurd + (platform + (target "i586-pc-gnu") + (system "i586-gnu"))) 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 @@ (define-module (gnu system image) #: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 @@ (define-module (gnu system image) 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 @@ (define iso9660-image (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 @@ (define* (arm32-disk-image #:optional (offset root-offset)) ;; 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 @@ (define uncompressed-iso-image-type (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 @@ (define* (system-image image) "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 @@ (define-module (gnu system images hurd) #: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-initialize-root-partition (define hurd-disk-image (image (format 'disk-image) - (target "i586-pc-gnu") (partitions (list (partition (size 'guess) @@ -103,13 +103,15 @@ (define hurd-qcow2-image-type (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 @@ (define-module (gnu system images novena) #: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-barebones-os (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 @@ (define-module (gnu system images pine64) #: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-barebones-os (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 @@ (define-module (gnu system images pinebook-pro) #: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 @@ (define pinebook-pro-image-type (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 @@ (define-module (gnu system images rock64) #: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-barebones-os (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/guix/scripts/system.scm b/guix/scripts/system.scm index 3b1fe570b3..7faa92fd7d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -64,6 +64,7 @@ (define-module (guix scripts system) (device-module-aliases matching-modules) #:use-module (gnu system linux-initrd) #:use-module (gnu image) + #:use-module (gnu platform) #:use-module (gnu system) #:use-module (gnu bootloader) #:use-module (gnu system file-systems) @@ -1212,13 +1213,11 @@ (define save-provenance? (base-image (if (operating-system? obj) (os->image obj #:type image-type) - obj)) - (base-target (image-target base-image))) + obj))) (image (inherit (if label (image-with-label base-image label) base-image)) - (target (or base-target target)) (size image-size) (volatile-root? volatile?)))) (os (image-operating-system image)) -- cgit v1.2.3