Merge branch 'master' into staging

7 files changed, 53 insertions, 27 deletions

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 42e215f614..dd32e58c2d 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,7 +32,7 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
-  #:use-module (gnu platform)
+  #:use-module (guix platform)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -218,7 +219,8 @@ set to the given OS."
       #$(partition-file-system-options partition)
       #$(partition-label partition)
       #$(and=> (partition-uuid partition)
-               uuid-bytevector)))
+               uuid-bytevector)
+      #$(partition-flags partition)))
 
 (define gcrypt-sqlite3&co
   ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
@@ -295,27 +297,45 @@ used in the image."
       ;; the hdimage format (raw disk-image) is supported.
       (cond
        ((memq format '(disk-image compressed-qcow2)) "hdimage")
-        (else
-         (raise (condition
-                 (&message
-                  (message
-                   (format #f (G_ "Unsupported image type ~a~%.") format))))))))
+       (else
+        (raise (condition
+                (&message
+                 (message
+                  (format #f (G_ "unsupported image type: ~a")
+                          format))))))))
 
     (define (partition->dos-type partition)
       ;; Return the MBR partition type corresponding to the given PARTITION.
       ;; See: https://en.wikipedia.org/wiki/Partition_type.
-      (let ((flags (partition-flags partition)))
+      (let ((flags (partition-flags partition))
+            (file-system (partition-file-system partition)))
         (cond
          ((member 'esp flags) "0xEF")
-         (else "0x83"))))
+         ((string-prefix? "ext" file-system) "0x83")
+         ((string=? file-system "vfat") "0x0E")
+         (else
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f (G_ "unsupported partition type: ~a")
+                            file-system)))))))))
 
     (define (partition->gpt-type partition)
-      ;; Return the genimage GPT partition type code corresponding to PARTITION.
-      ;; See https://github.com/pengutronix/genimage/blob/master/README.rst
-      (let ((flags (partition-flags partition)))
+      ;; Return the genimage GPT partition type code corresponding to the
+      ;; given PARTITION.  See:
+      ;; https://github.com/pengutronix/genimage/blob/master/README.rst
+      (let ((flags (partition-flags partition))
+            (file-system (partition-file-system partition)))
         (cond
-          ((member 'esp flags) "U")
-          (else "L"))))
+         ((member 'esp flags) "U")
+         ((string-prefix? "ext" file-system) "L")
+         ((string=? file-system "vfat") "F")
+         (else
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f (G_ "unsupported partition type: ~a")
+                            file-system)))))))))
 
     (define (partition-image partition)
       ;; Return as a file-like object, an image of the given PARTITION.  A
@@ -382,24 +402,28 @@ used in the image."
                     (partition-type-values image partition)))
         (let ((label (partition-label partition))
               (image (partition-image partition))
-              (offset (partition-offset partition)))
+              (offset (partition-offset partition))
+              (bootable (if (memq 'boot (partition-flags partition))
+                            "true" "false" )))
           #~(format #f "~/partition ~a {
   ~/~/~a = ~a
   ~/~/image = \"~a\"
   ~/~/offset = \"~a\"
+  ~/~/bootable = \"~a\"
   ~/}"
                     #$label
                     #$partition-type-attribute
                     #$partition-type-value
                     #$image
-                    #$offset))))
+                    #$offset
+                    #$bootable))))
 
     (define (genimage-type-options image-type image)
       (cond
-        ((equal? image-type "hdimage")
-         (format #f "~%~/~/gpt = ~a~%~/"
-                 (if (gpt-image? image) "true" "false")))
-        (else "")))
+       ((equal? image-type "hdimage")
+        (format #f "~%~/~/gpt = ~a~%~/"
+                (if (gpt-image? image) "true" "false")))
+       (else "")))
 
     (let* ((format (image-format image))
            (image-type (format->image-type format))
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 4c38c46a89..6da09b855a 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -23,7 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages ssh)
-  #:use-module (gnu platforms hurd)
+  #:use-module (guix platforms x86)
   #:use-module (gnu services)
   #:use-module (gnu services ssh)
   #:use-module (gnu system)
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 5b625e56c5..b9ff6dcfea 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -22,7 +22,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index aaec458766..99c4ed6ceb 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 1bfac7a8bb..7e8910427e 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index d25d55e528..68cb65f115 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services networking)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 073d7df1db..2fbf08f676 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
@@ -252,7 +252,9 @@ the user's target storage device rather than on the RAM disk."
   (service-type (name 'configuration-template)
                 (extensions
                  (list (service-extension etc-service-type
-                                          /etc/configuration-files)))))
+                                          /etc/configuration-files)))
+                (description "Install the operating system configuration file
+templates under @file{/etc/configuration}.")))
 
 (define %configuration-template-service
   (service configuration-template-service-type #t))