[bug#44169] [PATCH 0/3] Referring to swap with UUIDs and labels

[bug#44169] [PATCH 0/3] Referring to swap with UUIDs and labels

[Ludovic Courtès]

Hi!

Someone reported on IRC yesterday that the installer generates
‘swap-devices’ that explicitly list /dev nodes.

These patches change that so that it uses UUIDs instead.  It’s
only in the unencrypted case anyway, because I think we don’t
create swap partitions in the full-encrypted mode because the
partition would be unencrypted (or we’d need to set up another
LUKS mapping, but the installer doesn’t do that).

The ‘swap’ Shepherd service can now look up swap devices by
UUID/label.  Note that it uses the generic ‘find-partition-by-label’
and ‘find-partition-by-uuid’ procedures, which means it could
stumble upon a partition that’s not a swap partition.  That’s
unlikely and probably OK though: the worst that can happen is
that the ‘swap’ Shepherd service will fail to start.

Feedback welcome!

Ludo’.

Ludovic Courtès (3):
  file-systems: Allow swap space lookup by UUID/label.
  services: swap: Allow for UUIDs and file system labels.
  installer: Use UUIDs in the 'swap-devices' field.

 doc/guix.texi              | 34 +++++++++++++++++++----
 gnu/build/file-systems.scm | 43 ++++++++++++++++++++++++++++-
 gnu/installer/parted.scm   |  7 ++++-
 gnu/services/base.scm      | 55 +++++++++++++++++++++++++++++---------
 4 files changed, 120 insertions(+), 19 deletions(-)

-- 
2.28.0

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Ludovic Courtès]

* gnu/build/file-systems.scm (%linux-swap-magic, %page-size): New
variables.
(linux-swap-superblock?, read-linux-swap-superblock)
(linux-swap-superblock-uuid, linux-swap-superblock-volume-name): New
procedures.
(%partition-label-readers, %partition-uuid-readers): Add them.
---
 gnu/build/file-systems.scm | 43 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 734d648575..54a24e8d18 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@@ -179,6 +179,43 @@ if DEVICE does not contain an ext2 file system."
     (2 'reboot-required)
     (_ 'fatal-error)))
 
+\f
+;;;
+;;; Linux swap.
+;;;
+
+;; Linux "swap space" is not a file system but it has a UUID and volume name,
+;; like actual file systems, and we want to be able to look up swap partitions
+;; by UUID and by label.
+
+(define %linux-swap-magic
+  (string->utf8 "SWAPSPACE2"))
+
+;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h.
+(define %page-size 4096)
+
+(define (linux-swap-superblock? sblock)
+  "Return #t when SBLOCK is an linux-swap superblock."
+  (and (= (bytevector-length sblock) %page-size)
+       (bytevector=? (sub-bytevector sblock (- %page-size 10) 10)
+                     %linux-swap-magic)))
+
+(define (read-linux-swap-superblock device)
+  "Return the raw contents of DEVICE's linux-swap superblock as a bytevector, or #f
+if DEVICE does not contain an linux-swap file system."
+  (read-superblock device 0 %page-size linux-swap-superblock?))
+
+;; See 'union swap_header' in 'include/linux/swap.h'.
+
+(define (linux-swap-superblock-uuid sblock)
+  "Return the UUID of Linux-swap superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock (+ 1024 4 4 4) 16))
+
+(define (linux-swap-superblock-volume-name sblock)
+  "Return the label of Linux-swap superblock SBLOCK as a string."
+  (null-terminated-latin1->string
+   (sub-bytevector sblock (+ 1024 4 4 4 16) 16)))
+
 \f
 ;;;
 ;;; Btrfs file systems.
@@ -596,6 +633,8 @@ partition field reader that returned a value."
                                 iso9660-superblock-volume-name)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-volume-name)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-volume-name)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-volume-name)
         (partition-field-reader read-fat32-superblock
@@ -612,6 +651,8 @@ partition field reader that returned a value."
                                 iso9660-superblock-uuid)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-uuid)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-uuid)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-uuid)
         (partition-field-reader read-fat32-superblock
-- 
2.28.0

[bug#44169] [PATCH 2/3] services: swap: Allow for UUIDs and file system labels.

[Ludovic Courtès]

* gnu/services/base.scm (swap-service-type)[device-lookup, device-name]:
New variables.
Add 'modules' field to 'shepherd-service'.  In 'start' and 'stop', use
'device-lookup' to resolve UUIDs and labels.
* doc/guix.texi (operating-system Reference): Adjust accordingly.
---
 doc/guix.texi         | 34 ++++++++++++++++++++++----
 gnu/services/base.scm | 55 +++++++++++++++++++++++++++++++++----------
 2 files changed, 72 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b5061877e2..3f391d39f5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12935,14 +12935,38 @@ A list of mapped devices.  @xref{Mapped Devices}.
 @item @code{file-systems}
 A list of file systems.  @xref{File Systems}.
 
-@item @code{swap-devices} (default: @code{'()})
 @cindex swap devices
-A list of strings identifying devices or files to be used for ``swap
+@cindex swap space
+@item @code{swap-devices} (default: @code{'()})
+A list of UUIDs, file system labels, or strings identifying devices or
+files to be used for ``swap
 space'' (@pxref{Memory Concepts,,, libc, The GNU C Library Reference
-Manual}).  For example, @code{'("/dev/sda3")} or @code{'("/swapfile")}.
+Manual}).  Here are some examples:
+
+@table @code
+@item (list (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))
+Use the swap partition with the given UUID.  You can learn the UUID of a
+Linux swap partition by running @command{swaplabel @var{device}}, where
+@var{device} is the @file{/dev} file name of that partition.
+
+@item (list (file-system-label "swap"))
+Use the partition with label @code{swap}.  Again, the
+@command{swaplabel} command allows you to view and change the label of a
+Linux swap partition.
+
+@item (list "/swapfile")
+Use the file @file{/swapfile} as swap space.
+
+@item (list "/dev/sda3" "/dev/sdb2")
+Use the @file{/dev/sda3} and @file{/dev/sdb2} partitions as swap space.
+We recommend referring to swap devices by UUIDs or labels as shown above
+instead.
+@end table
+
 It is possible to specify a swap file in a file system on a mapped
-device, provided that the necessary device mapping and file system are
-also specified.  @xref{Mapped Devices} and @ref{File Systems}.
+device (under @file{/dev/mapper}), provided that the necessary device
+mapping and file system are also specified.  @xref{Mapped Devices} and
+@ref{File Systems}.
 
 @item @code{users} (default: @code{%base-user-accounts})
 @itemx @code{groups} (default: @code{%base-groups})
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 04bc991356..2280fda91b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2096,22 +2096,53 @@ instance."
    'swap
    (lambda (device)
      (define requirement
-       (if (string-prefix? "/dev/mapper/" device)
+       (if (and (string? device)
+                (string-prefix? "/dev/mapper/" device))
            (list (symbol-append 'device-mapping-
                                 (string->symbol (basename device))))
            '()))
 
-     (shepherd-service
-      (provision (list (symbol-append 'swap- (string->symbol device))))
-      (requirement `(udev ,@requirement))
-      (documentation "Enable the given swap device.")
-      (start #~(lambda ()
-                 (restart-on-EINTR (swapon #$device))
-                 #t))
-      (stop #~(lambda _
-                (restart-on-EINTR (swapoff #$device))
-                #f))
-      (respawn? #f)))))
+     (define (device-lookup device)
+       ;; The generic 'find-partition' procedures could return a partition
+       ;; that's not swap space, but that's unlikely.
+       (cond ((uuid? device)
+              #~(find-partition-by-uuid #$(uuid-bytevector device)))
+             ((file-system-label? device)
+              #~(find-partition-by-label
+                 #$(file-system-label->string device)))
+             (else
+              device)))
+
+     (define service-name
+       (symbol-append 'swap-
+                      (cond ((uuid? device)
+                             (string->symbol
+                              (string-take (uuid->string device) 6)))
+                            ((file-system-label? device)
+                             (string->symbol
+                              (file-system-label->string device)))
+                            (else
+                             device))))
+
+     (with-imported-modules (source-module-closure '((gnu build file-systems)))
+       (shepherd-service
+        (provision (list service-name))
+        (requirement `(udev ,@requirement))
+        (documentation "Enable the given swap device.")
+        (modules `((gnu build file-systems)
+                   ,@%default-modules))
+        (start #~(lambda ()
+                   (let ((device #$(device-lookup device)))
+                     (and device
+                          (begin
+                            (restart-on-EINTR (swapon device))
+                            #t)))))
+        (stop #~(lambda _
+                  (let ((device #$(device-lookup device)))
+                    (when device
+                      (restart-on-EINTR (swapoff device)))
+                    #f)))
+        (respawn? #f))))))
 
 (define (swap-service device)
   "Return a service that uses @var{device} as a swap device."
-- 
2.28.0

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Ludovic Courtès]

Note: This change requires an updated 'guix' package that contains
Linux-swap support in (gnu build file-systems).

* gnu/installer/parted.scm (user-partitions->configuration): Use UUIDs
in the 'swap-devices' field.
---
 gnu/installer/parted.scm | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index fffd5abf3b..d799ee0e73 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1327,7 +1327,12 @@ USER-PARTITIONS, or return nothing."
       ,@(initrd-configuration user-partitions)
       ,@(if (null? swap-devices)
             '()
-            `((swap-devices (list ,@swap-devices))))
+            (let* ((uuids (map (lambda (file)
+                                 (uuid->string (read-partition-uuid file)))
+                               swap-devices)))
+              `((swap-devices (list ,@(map (lambda (uuid)
+                                             `(uuid ,uuid))
+                                           uuids))))))
       ,@(if (null? encrypted-partitions)
             '()
             `((mapped-devices
-- 
2.28.0

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Mathieu Othacehe]

> +              `((swap-devices (list ,@(map (lambda (uuid)
> +                                             `(uuid ,uuid))
> +                                           uuids))))))

I fear that this will break the "gui-installed-os" test. The
"installation-target-os-for-gui-tests" procedure declares "/dev/vda2" as
swap-device, while the installer will declare it using an UUID.

This mismatch will probably make "shepherd services" test unhappy. We
could maybe set a swap label during installation and use it in the
installer tests?

Thanks,

Mathieu

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1239 bytes --]

Hi!

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> +              `((swap-devices (list ,@(map (lambda (uuid)
>> +                                             `(uuid ,uuid))
>> +                                           uuids))))))
>
> I fear that this will break the "gui-installed-os" test. The
> "installation-target-os-for-gui-tests" procedure declares "/dev/vda2" as
> swap-device, while the installer will declare it using an UUID.
>
> This mismatch will probably make "shepherd services" test unhappy. We
> could maybe set a swap label during installation and use it in the
> installer tests?

Good point, I had overlooked that.

I came up with the following trick: during installation, once user
partitions are formatted, we set a pre-defined UUID on /dev/vda2, and we
use that label in ‘installation-target-os-for-gui-tests’.

It works, but I think it’s racy: the config file could be generated
before we’ve changed the UUID.

Problem is that since formatting is the last step that occurs before
config file generation, there’s no synchronization point where the
installer could wait for the client (i.e., wait until the client has run
‘swaplabel’.)

Ideas?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4207 bytes --]

diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index ed38287fe8..1854b35656 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -777,5 +777,9 @@ by pressing the Exit button.~%~%")))
     ;; Make sure the disks are not in use before proceeding to formatting.
     (free-parted non-install-devices)
     (format-user-partitions user-partitions-with-pass)
+    (syslog "user partitions formatted~%")
+
+    ;; Let clients know that the partitions are ready.
+    (send-to-clients '(partitions-formatted))
     (destroy-form-and-pop form)
     user-partitions))
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 58bf0a2700..5962391e61 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -286,8 +286,8 @@ instrumented for further testing."
                                edit-configuration-file))
   "Converse over PORT to choose the partitioning method.  When ENCRYPTED? is
 true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
-This conversation goes past the final dialog box that shows the configuration
-file, actually starting the installation process."
+This conversation stops when the user partitions have been formatted, right
+before the final dialog box that shows the configuration file."
   (converse port
     ((list-selection (title "Partitioning method")
                      (multiple-choices? #f)
@@ -330,15 +330,19 @@ file, actually starting the installation process."
      #t)
     ((info (title "Preparing partitions") _ ...)
      (values))                                    ;nothing to return
+    ((partitions-formatted)
+     (values))))
+
+(define (conclude-installation port)
+  "Conclude the installation by checking over PORT that we get the generated
+configuration file, accepting it and starting the installation, and then
+receiving the final messages once the 'guix system init' process has
+completed."
+  (converse port
     ((file-dialog (title "Configuration file")
                   (text _)
                   (file ,configuration-file))
-     (edit-configuration-file configuration-file))))
-
-(define (conclude-installation port)
-  "Conclude the installation by checking over PORT that we get the final
-messages once the 'guix system init' process has completed."
-  (converse port
+     (edit-configuration-file configuration-file))
     ((pause)                                      ;"Press Enter to continue."
      #t)
     ((installation-complete)                      ;congratulations!
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 86bd93966b..0dc5f6ad94 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -1211,6 +1211,14 @@ build (current-guix) and then store a couple of full system images.")
                         #$marionette)
       (screenshot "installer-run.ppm")
 
+      (unless #$encrypted?
+        ;; Choose a fixed UUID for the swap partition that matches what
+        ;; 'installation-target-os-for-gui-tests' expects.
+        (marionette-eval* '(invoke #$(file-append util-linux "/sbin/swaplabel")
+                                   "-U" "11111111-2222-3333-4444-123456789abc"
+                                   "/dev/vda2")
+                          #$marionette))
+
       (marionette-eval* '(conclude-installation installer-socket)
                         #$marionette)
 
@@ -1257,8 +1265,12 @@ build (current-guix) and then store a couple of full system images.")
                            '("wheel" "audio" "video"))))
                    %base-user-accounts))
     ;; The installer does not create a swap device in guided mode with
-    ;; encryption support.
-    (swap-devices (if encrypted? '() '("/dev/vda2")))
+    ;; encryption support.  The installer produces a UUID for the partition;
+    ;; this "UUID" is explicitly set in 'gui-test-program' to the value shown
+    ;; below.
+    (swap-devices (if encrypted?
+                      '()
+                      (list (uuid "11111111-2222-3333-4444-123456789abc"))))
     (services (cons (service dhcp-client-service-type)
                     (operating-system-user-services %minimal-os-on-vda)))))
 

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Mathieu Othacehe]

Hey,

> I came up with the following trick: during installation, once user
> partitions are formatted, we set a pre-defined UUID on /dev/vda2, and we
> use that label in ‘installation-target-os-for-gui-tests’.
>
> It works, but I think it’s racy: the config file could be generated
> before we’ve changed the UUID.

Mmh that's problematic then. What about using swaplabel to set a label,
during the installation, only when there are connected clients and use
an UUID otherwise?

Thanks,

Mathieu

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Ludovic Courtès]

Hi!

Mathieu Othacehe <othacehe@gnu.org> skribis:

> Mmh that's problematic then. What about using swaplabel to set a label,
> during the installation, only when there are connected clients and use
> an UUID otherwise?

I unleashed my creativity, leading to the v2 I just sent.  The trick is
to add an explicit request/reply sequence with clients right before the
config file is generated.

I also added the comments regarding PAGE_SIZE as you suggested.

I think it’s probably OK for 1.2, though another round of testing for
the ISO would be welcome.

WDYT?

Thanks,
Ludo’.

bug#44169: [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Ludovic Courtès]

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> I unleashed my creativity, leading to the v2 I just sent.  The trick is
> to add an explicit request/reply sequence with clients right before the
> config file is generated.
>
> I also added the comments regarding PAGE_SIZE as you suggested.
>
> I think it’s probably OK for 1.2, though another round of testing for
> the ISO would be welcome.

I went ahead and pushed it as 1c6d98533153bc8e0e36236e7fbcf1eb5e178d26.

I’ll update the ‘guix’ package as a followup.

Thanks,
Ludo’.

[bug#44169] [PATCH 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Mathieu Othacehe]

Hey Ludo,

> I went ahead and pushed it as 1c6d98533153bc8e0e36236e7fbcf1eb5e178d26.

Sorry for not replying earlier, this looks fine :).

Thanks,

Mathieu

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Mathieu Othacehe]

Hey Ludo,

Thanks for this patchset, nice addition!

> +;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h.
> +(define %page-size 4096)

Page size is not necessarily 4096, it can be larger, which will break
the magic detection. I guess we need to use the system current page size
for a portable detection.

Thanks,

Mathieu

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> +;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h.
>> +(define %page-size 4096)
>
> Page size is not necessarily 4096, it can be larger, which will break
> the magic detection. I guess we need to use the system current page size
> for a portable detection.

It’s really the PAGE_SIZE constant, not the sysconf value.

We should check its value on the other arches we can about though.

Ludo’.

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Mathieu Othacehe]

Hey,

> We should check its value on the other arches we can about though.

On arm64, PAGE_SIZE is 1 << CONFIG_ARM64_PAGE_SHIFT which can be 12, 14
or 16 depending on the kernel config.

On arm and x86_64 it is fixed to 1 << 12 which makes things easier.

Mathieu

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Ludovic Courtès]

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

>> We should check its value on the other arches we can about though.
>
> On arm64, PAGE_SIZE is 1 << CONFIG_ARM64_PAGE_SHIFT which can be 12, 14
> or 16 depending on the kernel config.

Oh, so IOW we cannot get it right here?  Or should we try all three page
sizes on that architecture?  Do people actually configure with a
different page size?

> On arm and x86_64 it is fixed to 1 << 12 which makes things easier.

Phew.  I do think that 4K is pretty entrenched in people’s minds.  :-)

Ludo’.

[bug#44169] [PATCH 1/3] file-systems: Allow swap space lookup by UUID/label.

[Mathieu Othacehe]

Hey hey,

> Oh, so IOW we cannot get it right here?  Or should we try all three page
> sizes on that architecture?  Do people actually configure with a
> different page size?

Default is 12 on ARM64 and our kernel configuration does not change
it. So I think it would be fine to proceed with the current patch, maybe
with an extra comment.

Thanks,

Mathieu

[bug#44169] [PATCH v2 1/3] file-systems: Allow swap space lookup by UUID/label.

[Ludovic Courtès]

* gnu/build/file-systems.scm (%linux-swap-magic, %page-size): New
variables.
(linux-swap-superblock?, read-linux-swap-superblock)
(linux-swap-superblock-uuid, linux-swap-superblock-volume-name): New
procedures.
(%partition-label-readers, %partition-uuid-readers): Add them.
---
 gnu/build/file-systems.scm | 46 +++++++++++++++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 734d648575..8ec8eac896 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
@@ -179,6 +179,46 @@ if DEVICE does not contain an ext2 file system."
     (2 'reboot-required)
     (_ 'fatal-error)))
 
+\f
+;;;
+;;; Linux swap.
+;;;
+
+;; Linux "swap space" is not a file system but it has a UUID and volume name,
+;; like actual file systems, and we want to be able to look up swap partitions
+;; by UUID and by label.
+
+(define %linux-swap-magic
+  (string->utf8 "SWAPSPACE2"))
+
+;; Like 'PAGE_SIZE' in Linux, arch/x86/include/asm/page.h.
+;; XXX: This is always 4K on x86_64, i386, and ARMv7.  However, on AArch64,
+;; this is determined by 'CONFIG_ARM64_PAGE_SHIFT' in the kernel, which is 12
+;; by default (4K) but can be 14 or 16.
+(define %page-size 4096)
+
+(define (linux-swap-superblock? sblock)
+  "Return #t when SBLOCK is an linux-swap superblock."
+  (and (= (bytevector-length sblock) %page-size)
+       (bytevector=? (sub-bytevector sblock (- %page-size 10) 10)
+                     %linux-swap-magic)))
+
+(define (read-linux-swap-superblock device)
+  "Return the raw contents of DEVICE's linux-swap superblock as a bytevector, or #f
+if DEVICE does not contain an linux-swap file system."
+  (read-superblock device 0 %page-size linux-swap-superblock?))
+
+;; See 'union swap_header' in 'include/linux/swap.h'.
+
+(define (linux-swap-superblock-uuid sblock)
+  "Return the UUID of Linux-swap superblock SBLOCK as a 16-byte bytevector."
+  (sub-bytevector sblock (+ 1024 4 4 4) 16))
+
+(define (linux-swap-superblock-volume-name sblock)
+  "Return the label of Linux-swap superblock SBLOCK as a string."
+  (null-terminated-latin1->string
+   (sub-bytevector sblock (+ 1024 4 4 4 16) 16)))
+
 \f
 ;;;
 ;;; Btrfs file systems.
@@ -596,6 +636,8 @@ partition field reader that returned a value."
                                 iso9660-superblock-volume-name)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-volume-name)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-volume-name)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-volume-name)
         (partition-field-reader read-fat32-superblock
@@ -612,6 +654,8 @@ partition field reader that returned a value."
                                 iso9660-superblock-uuid)
         (partition-field-reader read-ext2-superblock
                                 ext2-superblock-uuid)
+        (partition-field-reader read-linux-swap-superblock
+                                linux-swap-superblock-uuid)
         (partition-field-reader read-btrfs-superblock
                                 btrfs-superblock-uuid)
         (partition-field-reader read-fat32-superblock
-- 
2.28.0

[bug#44169] [PATCH v2 2/3] services: swap: Allow for UUIDs and file system labels.

[Ludovic Courtès]

* gnu/services/base.scm (swap-service-type)[device-lookup, device-name]:
New variables.
Add 'modules' field to 'shepherd-service'.  In 'start' and 'stop', use
'device-lookup' to resolve UUIDs and labels.
* doc/guix.texi (operating-system Reference): Adjust accordingly.
---
 doc/guix.texi         | 34 +++++++++++++++++++++++----
 gnu/services/base.scm | 54 +++++++++++++++++++++++++++++++++----------
 2 files changed, 71 insertions(+), 17 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index efb4ea1c47..feb5760129 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13043,14 +13043,38 @@ A list of mapped devices.  @xref{Mapped Devices}.
 @item @code{file-systems}
 A list of file systems.  @xref{File Systems}.
 
-@item @code{swap-devices} (default: @code{'()})
 @cindex swap devices
-A list of strings identifying devices or files to be used for ``swap
+@cindex swap space
+@item @code{swap-devices} (default: @code{'()})
+A list of UUIDs, file system labels, or strings identifying devices or
+files to be used for ``swap
 space'' (@pxref{Memory Concepts,,, libc, The GNU C Library Reference
-Manual}).  For example, @code{'("/dev/sda3")} or @code{'("/swapfile")}.
+Manual}).  Here are some examples:
+
+@table @code
+@item (list (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb"))
+Use the swap partition with the given UUID.  You can learn the UUID of a
+Linux swap partition by running @command{swaplabel @var{device}}, where
+@var{device} is the @file{/dev} file name of that partition.
+
+@item (list (file-system-label "swap"))
+Use the partition with label @code{swap}.  Again, the
+@command{swaplabel} command allows you to view and change the label of a
+Linux swap partition.
+
+@item (list "/swapfile")
+Use the file @file{/swapfile} as swap space.
+
+@item (list "/dev/sda3" "/dev/sdb2")
+Use the @file{/dev/sda3} and @file{/dev/sdb2} partitions as swap space.
+We recommend referring to swap devices by UUIDs or labels as shown above
+instead.
+@end table
+
 It is possible to specify a swap file in a file system on a mapped
-device, provided that the necessary device mapping and file system are
-also specified.  @xref{Mapped Devices} and @ref{File Systems}.
+device (under @file{/dev/mapper}), provided that the necessary device
+mapping and file system are also specified.  @xref{Mapped Devices} and
+@ref{File Systems}.
 
 @item @code{users} (default: @code{%base-user-accounts})
 @itemx @code{groups} (default: @code{%base-groups})
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 37b0a13ea7..07d9089b0a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -2104,22 +2104,52 @@ instance."
    'swap
    (lambda (device)
      (define requirement
-       (if (string-prefix? "/dev/mapper/" device)
+       (if (and (string? device)
+                (string-prefix? "/dev/mapper/" device))
            (list (symbol-append 'device-mapping-
                                 (string->symbol (basename device))))
            '()))
 
-     (shepherd-service
-      (provision (list (symbol-append 'swap- (string->symbol device))))
-      (requirement `(udev ,@requirement))
-      (documentation "Enable the given swap device.")
-      (start #~(lambda ()
-                 (restart-on-EINTR (swapon #$device))
-                 #t))
-      (stop #~(lambda _
-                (restart-on-EINTR (swapoff #$device))
-                #f))
-      (respawn? #f)))))
+     (define (device-lookup device)
+       ;; The generic 'find-partition' procedures could return a partition
+       ;; that's not swap space, but that's unlikely.
+       (cond ((uuid? device)
+              #~(find-partition-by-uuid #$(uuid-bytevector device)))
+             ((file-system-label? device)
+              #~(find-partition-by-label
+                 #$(file-system-label->string device)))
+             (else
+              device)))
+
+     (define service-name
+       (symbol-append 'swap-
+                      (string->symbol
+                       (cond ((uuid? device)
+                              (string-take (uuid->string device) 6))
+                             ((file-system-label? device)
+                              (file-system-label->string device))
+                             (else
+                              device)))))
+
+     (with-imported-modules (source-module-closure '((gnu build file-systems)))
+       (shepherd-service
+        (provision (list service-name))
+        (requirement `(udev ,@requirement))
+        (documentation "Enable the given swap device.")
+        (modules `((gnu build file-systems)
+                   ,@%default-modules))
+        (start #~(lambda ()
+                   (let ((device #$(device-lookup device)))
+                     (and device
+                          (begin
+                            (restart-on-EINTR (swapon device))
+                            #t)))))
+        (stop #~(lambda _
+                  (let ((device #$(device-lookup device)))
+                    (when device
+                      (restart-on-EINTR (swapoff device)))
+                    #f)))
+        (respawn? #f))))))
 
 (define (swap-service device)
   "Return a service that uses @var{device} as a swap device."
-- 
2.28.0

[bug#44169] [PATCH v2 3/3] installer: Use UUIDs in the 'swap-devices' field.

[Ludovic Courtès]

Note: This change requires an updated 'guix' package that contains
Linux-swap support in (gnu build file-systems).

* gnu/installer/parted.scm (user-partitions->configuration): Use UUIDs
in the 'swap-devices' field.
* gnu/installer/newt/final.scm (run-final-page)[wait-for-clients]: New
procedure.   Use it.
* gnu/installer/tests.scm (choose-partitioning): Wait for
'starting-final-step' message and move configuration file dialog
handling to...
(conclude-installation): ... here.  Send over PORT the reply
corresponding to 'starting-final-step'.
* gnu/tests/install.scm (gui-test-program): When ENCRYPTED? is false,
invoke 'swaplabel' in the marionette.
(installation-target-os-for-gui-tests): When ENCRYPTED? is false, except
a fixed UUID.
---
 gnu/installer/newt/final.scm | 14 ++++++++++++++
 gnu/installer/parted.scm     |  7 ++++++-
 gnu/installer/tests.scm      | 31 +++++++++++++++++++++++--------
 gnu/tests/install.scm        | 18 ++++++++++++++++--
 4 files changed, 59 insertions(+), 11 deletions(-)

diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
index 89684c4d8a..5019a67429 100644
--- a/gnu/installer/newt/final.scm
+++ b/gnu/installer/newt/final.scm
@@ -29,6 +29,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:use-module ((ice-9 rdelim) #:select (read-line))
   #:use-module (newt)
   #:export (run-final-page))
 
@@ -107,6 +108,19 @@ a specific step, or restart the installer."))
     install-ok?))
 
 (define (run-final-page result prev-steps)
+  (define (wait-for-clients)
+    (unless (null? (current-clients))
+      (syslog "waiting with clients before starting final step~%")
+      (send-to-clients '(starting-final-step))
+      (match (select (current-clients) '() '())
+        (((port _ ...) _ _)
+         (read-line port)))))
+
+  ;; Before generating the configuration file, give clients a chance to do
+  ;; things such as changing the swap partition label.
+  (wait-for-clients)
+
+  (syslog "proceeding with final step~%")
   (let* ((configuration   (format-configuration prev-steps result))
          (user-partitions (result-step result 'partition))
          (locale          (result-step result 'locale))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index fffd5abf3b..d799ee0e73 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1327,7 +1327,12 @@ USER-PARTITIONS, or return nothing."
       ,@(initrd-configuration user-partitions)
       ,@(if (null? swap-devices)
             '()
-            `((swap-devices (list ,@swap-devices))))
+            (let* ((uuids (map (lambda (file)
+                                 (uuid->string (read-partition-uuid file)))
+                               swap-devices)))
+              `((swap-devices (list ,@(map (lambda (uuid)
+                                             `(uuid ,uuid))
+                                           uuids))))))
       ,@(if (null? encrypted-partitions)
             '()
             `((mapped-devices
diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm
index 58bf0a2700..f318546a2f 100644
--- a/gnu/installer/tests.scm
+++ b/gnu/installer/tests.scm
@@ -286,8 +286,9 @@ instrumented for further testing."
                                edit-configuration-file))
   "Converse over PORT to choose the partitioning method.  When ENCRYPTED? is
 true, choose full-disk encryption with PASSPHRASE as the LUKS passphrase.
-This conversation goes past the final dialog box that shows the configuration
-file, actually starting the installation process."
+This conversation stops when the user partitions have been formatted, right
+before the installer generates the configuration file and shows it in a dialog
+box."
   (converse port
     ((list-selection (title "Partitioning method")
                      (multiple-choices? #f)
@@ -330,15 +331,29 @@ file, actually starting the installation process."
      #t)
     ((info (title "Preparing partitions") _ ...)
      (values))                                    ;nothing to return
+    ((starting-final-step)
+     ;; Do not return anything.  The reply will be sent by
+     ;; 'conclude-installation' and in the meantime the installer just waits
+     ;; for us, giving us a chance to do things such as changing partition
+     ;; UUIDs before it generates the configuration file.
+     (values))))
+
+(define (conclude-installation port)
+  "Conclude the installation by checking over PORT that we get the generated
+configuration file, accepting it and starting the installation, and then
+receiving the final messages once the 'guix system init' process has
+completed."
+  ;; Assume the previous message received was 'starting-final-step'; here we
+  ;; send the reply to that message, which lets the installer continue.
+  (write #t port)
+  (newline port)
+  (force-output port)
+
+  (converse port
     ((file-dialog (title "Configuration file")
                   (text _)
                   (file ,configuration-file))
-     (edit-configuration-file configuration-file))))
-
-(define (conclude-installation port)
-  "Conclude the installation by checking over PORT that we get the final
-messages once the 'guix system init' process has completed."
-  (converse port
+     (edit-configuration-file configuration-file))
     ((pause)                                      ;"Press Enter to continue."
      #t)
     ((installation-complete)                      ;congratulations!
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 86bd93966b..2d62a873ca 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -1211,6 +1211,16 @@ build (current-guix) and then store a couple of full system images.")
                         #$marionette)
       (screenshot "installer-run.ppm")
 
+      (unless #$encrypted?
+        ;; At this point, user partitions are formatted and the installer is
+        ;; waiting for us to start the final step: generating the
+        ;; configuration file, etc.  Set a fixed UUID on the swap partition
+        ;; that matches what 'installation-target-os-for-gui-tests' expects.
+        (marionette-eval* '(invoke #$(file-append util-linux "/sbin/swaplabel")
+                                   "-U" "11111111-2222-3333-4444-123456789abc"
+                                   "/dev/vda2")
+                          #$marionette))
+
       (marionette-eval* '(conclude-installation installer-socket)
                         #$marionette)
 
@@ -1257,8 +1267,12 @@ build (current-guix) and then store a couple of full system images.")
                            '("wheel" "audio" "video"))))
                    %base-user-accounts))
     ;; The installer does not create a swap device in guided mode with
-    ;; encryption support.
-    (swap-devices (if encrypted? '() '("/dev/vda2")))
+    ;; encryption support.  The installer produces a UUID for the partition;
+    ;; this "UUID" is explicitly set in 'gui-test-program' to the value shown
+    ;; below.
+    (swap-devices (if encrypted?
+                      '()
+                      (list (uuid "11111111-2222-3333-4444-123456789abc"))))
     (services (cons (service dhcp-client-service-type)
                     (operating-system-user-services %minimal-os-on-vda)))))
 
-- 
2.28.0