[bug#51346] [PATCH 1/1] gnu: system: Add support for swap dependencies and flags

[bug#51346] [PATCH 1/1] gnu: system: Add support for swap dependencies and flags

[Josselin Poiret via Guix-patches via]

Add new record types swap-file and swap-partition while still
supporting the old style (for now). These support dependencies, as
well as swapon flags.

* gnu/system/file-systems.scm (swap-file, swap-partition): Add them.
* gnu/system.scm (operating-system)[swap-devices]: Update comment.
* gnu/services/base.scm (swap-partition->service-name,
swap-file->service-name, swap-deprecated->service-name,
swap->service-name): Add them.
* gnu/services/base.scm (swap-service-type): Make it use the new
record types and flags.
* gnu/build/syscalls.scm (SWAP_FLAG_PREFER, SWAP_FLAG_PRIO_MASK,
SWAP_FLAG_PRIO_SHIFT, SWAP_FLAG_DISCARD): Add flags from glibc.
* gnu/build/file-systems.scm (swap-flags->bit-mask): Add it.
* doc/guix.texi (Swap Space): Add new section.
* doc/guix.texi (operating-system Reference): Update it.
---
 doc/guix.texi               |  98 +++++++++++++++++++---------
 gnu/build/file-systems.scm  |  25 ++++++-
 gnu/services/base.scm       | 126 ++++++++++++++++++++++++++----------
 gnu/system.scm              |   4 +-
 gnu/system/file-systems.scm |  34 +++++++++-
 guix/build/syscalls.scm     |  12 ++++
 6 files changed, 230 insertions(+), 69 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 67a05a10ff..88b097b3a8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -319,6 +319,7 @@ System Configuration
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Adding swap space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -13769,6 +13770,7 @@ instance to support new system services.
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Adding swap space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -14135,38 +14137,11 @@ A list of mapped devices.  @xref{Mapped Devices}.
 @item @code{file-systems}
 A list of file systems.  @xref{File Systems}.
 
-@cindex swap devices
-@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}).  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 (under @file{/dev/mapper}), provided that the necessary device
-mapping and file system are also specified.  @xref{Mapped Devices} and
-@ref{File Systems}.
+@cindex swap devices
+A list of @code{<swap-partition>} or @code{<swap-file>} objects
+(@pxref{Swap Space}), to be used for ``swap space'' (@pxref{Memory
+Concepts,,, libc, The GNU C Library Reference Manual}).
 
 @item @code{users} (default: @code{%base-user-accounts})
 @itemx @code{groups} (default: @code{%base-groups})
@@ -14788,6 +14763,67 @@ Devices @file{/dev/mapper/vg0-alpha} and @file{/dev/mapper/vg0-beta} can
 then be used as the @code{device} of a @code{file-system} declaration
 (@pxref{File Systems}).
 
+@node Swap Space
+@section Swap Space
+@cindex swap space
+
+@deftp {Data Type} swap-partition
+Objects of this type represent swap partitions. They contain the following
+members:
+
+@table @asis
+@item @code{device}
+The device to use, either a UUID, a @code{file-system-label} or a string,
+as in the definition of a @code{file-system} (@pxref{File Systems}).
+
+@item @code{dependencies} (default: @code{'()})
+A list of @code{mapped-device} objects, upon which the availability of
+the device depends.
+
+@item @code{flags} (default: @code{'()})
+A list of flags. The supported flags are @code{'delayed} and
+@code{('priority n)}, see @command{man 2 swapon} in the kernel man pages
+(@code{man-pages} guix package) for more information.
+
+@end table
+@end deftp
+
+@deftp {Data Type} swap-file
+Objects of this type represent swap files. They contain the following
+members:
+
+@table @asis
+@item @code{path}
+A string, specifying the file path of the swap file to use.
+
+@item @code{fs}
+A @code{file-system} object representing the file system inside which the
+swap file may be found.
+
+@item @code{flags} (default: @code{'()})
+See the @code{flags} member of @code{swap-partition}.
+
+@end table
+@end deftp
+
+Here are some examples:
+
+@table @code
+@item (swap-partition (device (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 (swap-partition (device (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 (swap-file (path "/swapfile") (fs root-fs))
+Use the file @file{/swapfile} as swap space, which is present on the
+@var{root-fs} filesystem.
+@end table
+
 @node User Accounts
 @section User Accounts
 
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index d8a5ddf1e5..e9806620fb 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -29,6 +29,8 @@ (define-module (gnu build file-systems)
   #:use-module (guix build bournish)
   #:use-module ((guix build syscalls)
                 #:hide (file-system-type))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -54,7 +56,9 @@ (define-module (gnu build file-systems)
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system))
+            mount-file-system
+
+            swap-flags->bit-mask))
 
 ;;; Commentary:
 ;;;
@@ -227,6 +231,25 @@ (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)))
+
+(define (swap-flags->bit-mask flags)
+  "Return the number suitable for the 'flags' argument of 'mount' that
+corresponds to the symbols listed in FLAGS."
+  (let loop ((flags flags))
+    (match flags
+      ((('priority p) rest ...)
+       (if (<= 0 p SWAP_FLAG_PRIO_MASK) ; Here we take for granted that shift == 0
+           (logior SWAP_FLAG_PREFER
+                   p
+                   (loop rest))
+           (begin (warning (G_ "Given swap priority ~a is not contained
+between 0 and ~a. Ignoring.~%") p SWAP_FLAG_PRIO_MASK)
+                  (loop rest))))
+      (('discard rest ...)
+       (logior SWAP_FLAG_DISCARD (loop rest)))
+      (()
+       0))))
+
 \f
 
 ;;;
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..9b70e59b6f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -58,11 +58,14 @@ (define-module (gnu services base)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
-                #:select (mount-flags->bit-mask))
+                #:select (mount-flags->bit-mask
+                          swap-flags->bit-mask))
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -2146,62 +2149,117 @@ (define* (udev-rules-service name rules #:key (groups '()))
                               udev-service-type udev-extension))))))
     (service type #f)))
 
+(define (swap-partition->service-name spartition)
+  (let ((device (swap-partition-device spartition)))
+    (symbol-append 'swap-
+                   (string->symbol
+                    (cond ((uuid? device)
+                           (uuid->string device))
+                          ((file-system-label? device)
+                           (file-system-label->string device))
+                          (else
+                           device))))))
+
+(define (swap-file->service-name sfile)
+  (symbol-append 'swap- (string->symbol (swap-file-path sfile))))
+
+; TODO Remove after deprecation
+(define (swap-deprecated->service-name sdep)
+  (symbol-append 'swap-
+                 (string->symbol
+                  (cond ((uuid? sdep)
+                         (string-take (uuid->string sdep) 6))
+                        ((file-system-label? sdep)
+                         (file-system-label->string sdep))
+                        (else
+                         sdep)))))
+
+(define swap->service-name
+  (match-lambda ((? swap-partition? spartition)
+                 (swap-partition->service-name spartition))
+                ((? swap-file? sfile)
+                 (swap-file->service-name sfile))
+                (sdep
+                 (swap-deprecated->service-name sdep))))
+
 (define swap-service-type
   (shepherd-service-type
    'swap
-   (lambda (device)
-     (define requirement
-       (if (and (string? device)
-                (string-prefix? "/dev/mapper/" device))
-           (list (symbol-append 'device-mapping-
-                                (string->symbol (basename device))))
-           '()))
-
-     (define (device-lookup device)
+   (lambda (swap)
+     (define requirements
+       (cond ((swap-partition? swap)
+              (map dependency->shepherd-service-name
+                   (swap-partition-dependencies swap)))
+             ((swap-file? swap)
+              (list (dependency->shepherd-service-name
+                     (swap-file-fs swap))))
+             ; TODO Remove after deprecation
+             ((and (string? swap) (string-prefix? "/dev/mapper/" swap))
+              (list (symbol-append 'device-mapping-
+                                   (string->symbol (basename swap)))))
+             (else
+              '())))
+
+     (define device-lookup
        ;; 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)
+       (cond ((swap-partition? swap)
+              (let ((device (swap-partition-device swap)))
+                (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))))
+             ((swap-file? swap)
+              (swap-file-path swap))
+             ; TODO Remove after deprecation
+             ((uuid? swap)
+              #~(find-partition-by-uuid #$(uuid-bytevector swap)))
+             ((file-system-label? swap)
               #~(find-partition-by-label
-                 #$(file-system-label->string device)))
+                 #$(file-system-label->string swap)))
              (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)))))
+              swap)))
+
+     (define flags
+       (cond ((swap-partition? swap)
+              (swap-partition-flags swap))
+             ((swap-file? swap)
+              (swap-file-flags swap))
+             (else '())))
 
      (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.")
+        (provision (list (swap->service-name swap)))
+        (requirement `(udev ,@requirements))
+        (documentation "Enable the given swap space.")
         (modules `((gnu build file-systems)
                    ,@%default-modules))
         (start #~(lambda ()
-                   (let ((device #$(device-lookup device)))
+                   (let ((device #$device-lookup))
                      (and device
                           (begin
-                            (restart-on-EINTR (swapon device))
+                            (restart-on-EINTR (swapon device
+                                                      #$(swap-flags->bit-mask
+                                                         flags)))
                             #t)))))
         (stop #~(lambda _
-                  (let ((device #$(device-lookup device)))
+                  (let ((device #$device-lookup))
                     (when device
                       (restart-on-EINTR (swapoff device)))
                     #f)))
         (respawn? #f))))
    (description "Turn on the virtual memory swap area.")))
 
-(define (swap-service device)
-  "Return a service that uses @var{device} as a swap device."
-  (service swap-service-type device))
+(define (swap-service swap)
+  "Return a service that uses @var{swap} as a swap space."
+  (unless (or (swap-partition? swap) (swap-file? swap))
+    (warning (G_ "Specifying swap space without @code{swap-partition} or
+@code{swap-file} is deprecated, see \"(guix) operating-system Reference\" for
+more details.~%")))
+  (service swap-service-type swap))
 
 (define %default-gpm-options
   ;; Default options for GPM.
diff --git a/gnu/system.scm b/gnu/system.scm
index 58b594694a..f732840488 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -234,8 +234,8 @@ (define-record-type* <operating-system> operating-system
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
                   (default '()))
   (file-systems operating-system-file-systems)    ; list of fs
-  (swap-devices operating-system-swap-devices     ; list of strings
-                (default '()))
+  (swap-devices operating-system-swap-devices     ; list of string | <swap-file> |
+                (default '()))                    ; <swap-partition>
 
   (users operating-system-users                   ; list of user accounts
          (default %base-user-accounts))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index e69cfd06e6..105f1e449b 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -96,7 +96,19 @@ (define-module (gnu system file-systems)
 
             %store-mapping
             %network-configuration-files
-            %network-file-mappings))
+            %network-file-mappings
+
+            swap-file
+            swap-file?
+            swap-file-path
+            swap-file-fs
+            swap-file-flags
+
+            swap-partition
+            swap-partition?
+            swap-partition-device
+            swap-partition-dependencies
+            swap-partition-flags))
 
 ;;; Commentary:
 ;;;
@@ -671,4 +683,24 @@ (define (prepend-slash/maybe s)
                   (G_ "Use the @code{subvol} Btrfs file system option."))))))))
 
 
+;;;
+;;; Swap partition and files
+;;;
+
+(define-record-type* <swap-partition> swap-partition make-swap-partition
+  swap-partition?
+  this-swap-partition
+  (device swap-partition-device)
+  (dependencies swap-partition-dependencies
+                (default '()))
+  (flags swap-partition-flags
+         (default '())))
+
+(define-record-type* <swap-file> swap-file make-swap-file swap-file?
+  this-swap-file
+  (path swap-file-path)
+  (fs swap-file-fs)
+  (flags swap-file-flags
+         (default '())))
+
 ;;; file-systems.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 99a3b45004..ae52c0ec54 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -71,6 +71,11 @@ (define-module (guix build syscalls)
             mounts
             mount-points
 
+            SWAP_FLAG_PREFER
+            SWAP_FLAG_PRIO_MASK
+            SWAP_FLAG_PRIO_SHIFT
+            SWAP_FLAG_DISCARD
+
             swapon
             swapoff
 
@@ -677,6 +682,13 @@ (define (mount-points)
   "Return the mounts points for currently mounted file systems."
   (map mount-point (mounts)))
 
+;; Pulled from glibc's sysdeps/unix/sysv/linux/sys/swap.h
+
+(define SWAP_FLAG_PREFER     #x8000) ;; Set if swap priority is specified.
+(define SWAP_FLAG_PRIO_MASK  #x7fff)
+(define SWAP_FLAG_PRIO_SHIFT 0)
+(define SWAP_FLAG_DISCARD    #x10000) ;;
+
 (define swapon
   (let ((proc (syscall->procedure int "swapon" (list '* int))))
     (lambda* (device #:optional (flags 0))
-- 
2.33.1

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Josselin Poiret via Guix-patches via]

Hi,

This patchset adds new record types swap-partition and swap-file, to be used in the swap-devices field of operating-system. These support dependencies on mapped-device and file-system objects respectively, as well as swapon flags. I pulled those from GNU libc, and in the manual I refer to 'man 2 swapon' for the description of these flags. Support for the old style is kept for now, but I added deprecation warnings.

This works well on my laptop, whereas my swap file used to never be swapon on boot because it wasn't available yet (on BTRFS on LUKS). I don't have a swap partition lying around though so testers welcome!

I hope this can make it in time for the core-updates-frozen merge. I also plan to add swap file hibernation support eventually, where the file offsets are automatically determined by guix (or we could even write our own suspend/resume script in guile, see https://www.kernel.org/doc/html/latest/power/userland-swsusp.html).

Josselin Poiret (1):
  gnu: system: Add support for swap dependencies and flags

 doc/guix.texi               |  98 +++++++++++++++++++---------
 gnu/build/file-systems.scm  |  25 ++++++-
 gnu/services/base.scm       | 126 ++++++++++++++++++++++++++----------
 gnu/system.scm              |   4 +-
 gnu/system/file-systems.scm |  34 +++++++++-
 guix/build/syscalls.scm     |  12 ++++
 6 files changed, 230 insertions(+), 69 deletions(-)

-- 
2.33.1

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Tobias Geerinckx-Rice via Guix-patches via]

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

Josselin,

Josselin Poiret via Guix-patches via 写道：
> This patchset adds new record types swap-partition and 
> swap-file, to be used in the swap-devices field of 
> operating-system.

Thank you so much for this.

Do you happen to know anything about how the Hurd handles swap?

> in the manual I refer to 'man 2 swapon' for the description of 
> these flags.

I think we should document the basics ourselves.  We can still 
refer to the man page if you think it's needed.  WDYT?

Pity that there's no (libc) Info node to which we can link.

> This works well on my laptop, whereas my swap file used to never 
> be swapon on boot because it wasn't available yet (on BTRFS on 
> LUKS). I don't have a swap partition lying around though so 
> testers welcome!

Also boots fine with my plain swap partition:

  (swap-devices (list (swap-partition
                       (device hibernation-device))))

Not having to explicitly manage HIBERNATION-DEVICE, as you suggest 
below, sounds nice too :-)

> I hope this can make it in time for the core-updates-frozen 
> merge.

As noted on IRC, I don't see a reason to involve core-updates at 
all.

We should take the time to define solid interfaces but, once done, 
this can go straight to master.

> I also plan to add swap file hibernation support eventually, 
> where the file offsets are automatically determined by guix (or 
> we could even write our own suspend/resume script in guile, see 
> https://www.kernel.org/doc/html/latest/power/userland-swsusp.html).

Okay.  As also implied on IRC… I have a very low opinion of 
uswsusp.  It's brittle, gimmicky, and introduces many ways for 
bugs to hide and boots to break.  We'll have to carefully track 
incompatible format changes and kernel/initrd generations.

If it is added, we shouldn't involve early userspace in cases 
where it's not strictly needed.

But that for later :-)

> +++ b/doc/guix.texi
> +* Swap Space::                  Adding swap space.

You're following existing precedent here, but I just read the same 
thing twice.

I suggest ‘Swap Space:: Adding virtual memory to free up precious 
RAM.’.

> +@cindex swap devices
> +A list of @code{<swap-partition>} or @code{<swap-file>} objects
> +(@pxref{Swap Space}), to be used for ``swap space'' 
> (@pxref{Memory
> +Concepts,,, libc, The GNU C Library Reference Manual}).

At the risk of leaving this very stubby, I think the (libc) ref 
should be moved to the Swap Space node, which readers might visit 
directly without reading the above.

> +@node Swap Space
> +@section Swap Space
> +@cindex swap space

…so, here.

I'm missing a short intro sentence that mentions what swap is for, 
and that it comes in 2 common forms.

The libc explanation is quite technical, doesn't actually define 
‘swap space’ except by implication, and immediately rambles on 
about zeroes that don't even exist.  As a new user, I think I'd 
feel lost.

> +@deftp {Data Type} swap-partition
> +Objects of this type represent swap partitions. They contain 
> the following
> +members:

(What are ‘swap partitions’?  Maybe explain the pros/cons of both 
in each @deftp intro.  Mostly a reminder to myself, but if you 
want to write more docs: be my guest.)

Always double-space after full stops in prose.

> +@item @code{flags} (default: @code{'()})
> +A list of flags. The supported flags are @code{'delayed} and
> +@code{('priority n)}, see @command{man 2 swapon} in the kernel 
> man pages
> +(@code{man-pages} guix package) for more information.

'delayed?  To?  When?

I'm unenthusiastic about this interface.

On the one hand, exposing this tiny and ossified list of 2.5 
‘flags’ (what even is that priority… thing…) this way feels like 
exposing users to an ugly C implementation detail for no benefit: 
why not

  (swap-partition
    (priority 5) ; or #f distinct from 0
    (discard? #t)
    …)

instead?

On the other hand: perhaps other kernels expose different flags 
and this model might make sense.  I'm not convinced, but I'm 
willing to be.

> +A string, specifying the file path of the swap file to use.

s/file path/name/

> +@item @code{fs}

s/fs/file-system/

As a rule, avoid such pointless abbreviation.  GNU's not unix, 
thankfully.

That said, why does this field exist at all?  The example given 
here:

> +@item (swap-file (path "/swapfile") (fs root-fs))
> +Use the file @file{/swapfile} as swap space, which is present 
> on the
> +@var{root-fs} filesystem.

…rather side-steps the question of how this is supposed to work, 
or in which situation it makes sense.  I feel like it's papering 
over a bug.

> +(define (swap-flags->bit-mask flags)

So I made the mistake of looking at how util-linux does this.

Firstly, it silently clamps (> priority max) to MAX.  I think it 
makes sense to follow that behaviour, but print a warning. 
Ignoring (< priority 0), with a warning, is fine.

Secondly, and this is just weird, ‘man 2 swapon’ explicitly 
documents:

  (prio << SWAP_FLAG_PRIO_SHIFT) & SWAP_FLAG_PRIO_MASK

so naturally util-linux's swapon.c explicitly does this:

  (prio & SWAP_FLAG_PRIO_MASK) << SWAP_FLAG_PRIO_SHIFT

What?  Surely this ancient code can't work just by sheer luck… 
I'll ask.

I see no advantage in ignoring SWAP_FLAG_PRIO_SHIFT, only risks. 
Let's not.

Here's how I'd write it:

--8<---------------cut here---------------start------------->8---
(define (swap-flags->bit-mask flags)
  "Return the number suitable for the 'flags' argument of 'mount' 
  that
corresponds to the symbols listed in FLAGS."
  (let loop ((flags flags))
    (match flags
      ((('priority p) rest ...)
       (if (< p 0)
           (begin (warning
                   (G_ "Ignoring swap priority ~a as it is less 
                   than 0.~%" p))
                  (loop rest))
           (let* ((max (ash SWAP_FLAG_PRIO_MASK (- 
           SWAP_FLAG_PRIO_SHIFT)))
                  (pri (if (> p max)
                           (begin (warning
                                   (G_ "Limiting swap priority ~a to ~a.~%"
                                       p max))
                                  max)
                           p)))
             (logior SWAP_FLAG_PREFER
                     (ash pri SWAP_FLAG_PRIO_SHIFT)
                     (loop rest)))))
      (('discard rest ...)
       (logior SWAP_FLAG_DISCARD (loop rest)))
      (()
       0))))
--8<---------------cut here---------------end--------------->8---

It should also handle invalid input by printing the offending 
symbol instead of a generic match error, but I'm about to board my 
train, and will call it a night here.

Kind regards,

T G-R

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

[bug#51346] [PATCH 1/1] gnu: system: Add support for swap dependencies and flags

[Tobias Geerinckx-Rice via Guix-patches via]

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

Oh no,

he's back.  With another annoying question: why don't we drop the 
whole swap-partition/swap-file dichotomy?  The distinction is 
artificial insofar as Linux doesn't make one.

Which end is supposed to explode if you

  (swap-partition (device "/home/nckx/swap"))
  (swap-file (name "/dev/sda2"))

?

What real-world drawback(s) do you see to

  (swap (space "/home/nckx/swap"))
  (swap (space "/dev/sda2"))
  (swap (space (uuid "ab-c-d-e-fgh")))
  (swap (space (file-system-label "best-swaps")))

naming aside?

Josselin Poiret via Guix-patches via 写道：
> +(define (swap-partition->service-name spartition)

Nitpick: ->shepherd-service-name just for similarity to 
<file-system>s.

Aside, when I try to apply your third manual example, I get:

  guix system: error: service 'swap-/dev/sda2' requires
  'file-system-/', which is not provided by any service

Kind regards,

T G-R

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Josselin Poiret via Guix-patches via]

Hi,



First and foremost, thank you for your review!



On 10/24/21 2:05 AM, Tobias Geerinckx-Rice wrote:

> Do you happen to know anything about how the Hurd handles swap?



I'm investigating this currently, got a Hurd vm up and running ("guix system image -t hurd-raw" is very nice). We talked about this on IRC, and decided that it would be easier to simply used the Hurd's swapon binary (from the hurd package itself), rather than directly communicate with the default_pager server, since that'd involve writing a lot of Hurd RPC code. In the long run, this would be the way to go, just like for Linux (we use (guix build syscalls) instead of util-linux's swapon), but getting initial support in faster would be great.



>> in the manual I refer to 'man 2 swapon' for the description of these flags.

> 

> I think we should document the basics ourselves.  We can still refer to the man page if you think it's needed.  WDYT?

> 

> Pity that there's no (libc) Info node to which we can link.



Now that I'm looking at it, they really are not that complicated, I'll write something to describe them then.


>> +++ b/doc/guix.texi

>> +* Swap Space::                  Adding swap space.

> 

> You're following existing precedent here, but I just read the same thing twice.

> 

> I suggest ‘Swap Space:: Adding virtual memory to free up precious RAM.’.



Noted! Maybe something along "Backing RAM with disk space." rather, as swap space isn't really memory?



>> +@cindex swap devices

>> +A list of @code{<swap-partition>} or @code{<swap-file>} objects

>> +(@pxref{Swap Space}), to be used for ``swap space'' (@pxref{Memory

>> +Concepts,,, libc, The GNU C Library Reference Manual}).

> 

> At the risk of leaving this very stubby, I think the (libc) ref should be moved to the Swap Space node, which readers might visit directly without reading the above.

> 

>> +@node Swap Space

>> +@section Swap Space

>> +@cindex swap space

> 

> …so, here.

> 

> I'm missing a short intro sentence that mentions what swap is for, and that it comes in 2 common forms.

> 

> The libc explanation is quite technical, doesn't actually define ‘swap space’ except by implication, and immediately rambles on about zeroes that don't even exist.  As a new user, I think I'd feel lost.



Will add.



>> +@deftp {Data Type} swap-partition

>> +Objects of this type represent swap partitions. They contain the following

>> +members:

> 

> (What are ‘swap partitions’?  Maybe explain the pros/cons of both in each @deftp intro.  Mostly a reminder to myself, but if you want to write more docs: be my guest.)

> 

> Always double-space after full stops in prose.

> 

>> +@item @code{flags} (default: @code{'()})

>> +A list of flags. The supported flags are @code{'delayed} and

>> +@code{('priority n)}, see @command{man 2 swapon} in the kernel man pages

>> +(@code{man-pages} guix package) for more information.

> 

> 'delayed?  To?  When?

> 

> I'm unenthusiastic about this interface.

> 

> On the one hand, exposing this tiny and ossified list of 2.5 ‘flags’ (what even is that priority… thing…) this way feels like exposing users to an ugly C implementation detail for no benefit: why not

> 

>  (swap-partition

>    (priority 5) ; or #f distinct from 0

>    (discard? #t)

>    …)

> 

> instead?

> 

> On the other hand: perhaps other kernels expose different flags and this model might make sense.  I'm not convinced, but I'm willing to be.


Welp, looks like you gave me the perfect excuse: from what I gather, Hurd does not have any flags for its swap space (see hurd/default_pager.defs, line 86). The other part of the reason is that I did not want to have even more "swap-partition-priority"/"swap-file-priority" duplicate accessors (more on swap-file/swap-partition below).



>> +A string, specifying the file path of the swap file to use.

> 

> s/file path/name/

> 

>> +@item @code{fs}

> 

> s/fs/file-system/

> 

> As a rule, avoid such pointless abbreviation.  GNU's not unix, thankfully.

> 

> That said, why does this field exist at all?  The example given here:

> 

>> +@item (swap-file (path "/swapfile") (fs root-fs))

>> +Use the file @file{/swapfile} as swap space, which is present on the

>> +@var{root-fs} filesystem.

> 

> …rather side-steps the question of how this is supposed to work, or in which situation it makes sense.  I feel like it's papering over a bug.



Abbreviation aside, the example is bad: even though theoretically presence of the swap file depends on the root filesystem being mounted, well, root-fs is always mounted and should be ignored (there's no filesystem-/ service either). A better example would be my personal configuration:



(swap-devices (list

 (swap-file

  (path "/btrfs/swapfile")

  (fs (car (filter (lambda (x)

		     (equal? (file-system-mount-point x)

			     "/btrfs"))

		   file-systems)))))) 



You can see here that /btrfs/swapfile wouldn't be accessible if the filesystem under fs wasn't mounted first.



>> +(define (swap-flags->bit-mask flags)

> 

> So I made the mistake of looking at how util-linux does this.

> 

> Firstly, it silently clamps (> priority max) to MAX.  I think it makes sense to follow that behaviour, but print a warning. Ignoring (< priority 0), with a warning, is fine.

> 

> Secondly, and this is just weird, ‘man 2 swapon’ explicitly documents:

> 

>  (prio << SWAP_FLAG_PRIO_SHIFT) & SWAP_FLAG_PRIO_MASK

> 

> so naturally util-linux's swapon.c explicitly does this:

> 

>  (prio & SWAP_FLAG_PRIO_MASK) << SWAP_FLAG_PRIO_SHIFT

> 

> What?  Surely this ancient code can't work just by sheer luck… I'll ask.


I mean, SWAP_FLAG_PRIO_SHIFT has been equal 0 since at least the initial linux git commit 17 years ago, so it might actually be sheer luck.



> I see no advantage in ignoring SWAP_FLAG_PRIO_SHIFT, only risks. Let's not.


How I saw it: if SWAP_FLAG_PRIO_SHIFT ever changes from 0, and our code actually cared about its value, we'd still have to notice the change and change the value (it would be different if we were parsing linux headers instead). But I guess that's mostly laziness on my part, and since you wrote a nice replacement, I guess I'll add that.



> It should also handle invalid input by printing the offending symbol instead of a generic match error, but I'm about to board my train, and will call it a night here.


Will do!





On 10/24/21 1:58 PM, Tobias Geerinckx-Rice wrote:

> Oh no,

> 

> he's back.  With another annoying question: why don't we drop the whole swap-partition/swap-file dichotomy?  The distinction is artificial insofar as Linux doesn't make one.

> 

> Which end is supposed to explode if you

> 

>  (swap-partition (device "/home/nckx/swap"))

>  (swap-file (name "/dev/sda2"))

>

> ?

>

> What real-world drawback(s) do you see to

> 

>  (swap (space "/home/nckx/swap"))

>  (swap (space "/dev/sda2"))

>  (swap (space (uuid "ab-c-d-e-fgh")))

>  (swap (space (file-system-label "best-swaps")))

> 

> naming aside?



The motivating thing for me was that they have to be treated differently for hibernation purposes: you shouldn't make the dependencies of a swap file available (ie mount the filesystem it's on) but rather determine its offset inside the block device. For a swap partition, there's no such thing, you have to make the device itself available to the kernel. We could have a swapfile? flag instead though, but I'm still not convinced by both approaches. For the current patch though, nothing is going to explode there (although for a swap-file you do have to specify the filesystem it is on, but that's just my record definition forcing you to).



> Josselin Poiret via Guix-patches via 写道：

>> +(define (swap-partition->service-name spartition)

> 

> Nitpick: ->shepherd-service-name just for similarity to <file-system>s.

> 

> Aside, when I try to apply your third manual example, I get:

> 

>  guix system: error: service 'swap-/dev/sda2' requires

>  'file-system-/', which is not provided by any service



I forgot that the root filesystem is treated differently from others, so this example is borked. I'll add something akin to my config instead. On a tangential note, there's nothing stopping us from renaming root-file-system to file-system-/, so that these at least don't give an error, right (they're logically not wrong dependencies, although a bit useless)?



Thanks again for your review!

A revised patchset (yes, this time with multiple commits) will be coming soon, once I figure out the proper way to work with block devices on Hurd.



Best,

Josselin Poiret

[bug#51346] [PATCH v2 0/4] Rework swap, add flags and dependencies.

[Josselin Poiret via Guix-patches via]

Hi,

Alright, this new revised and expanded patchset should take into
account most of the previous remarks, as well as fix some corner
cases.

Akin to what is done for file system services, I've modified
swap-services so that it filters out boot-time dependencies which
cannot be managed by Shepherd.

In doing so, I noticed that the non-boot-file-system-services
procedure automagically adds mapped devices dependencies that it
detects: is that documented behaviour, are we trying to support it or
are we trying to move away from it?

The documentation should now be self-sufficient, with the example
desktop configuration updated to contain a swap file.

Josselin Poiret (4):
  gnu: system: Rework swap space support, add dependencies.
  gnu: system: Add swap flags.
  gnu: system: Filter out boot dependencies from swap-space.
  doc: Add new Swap Space section.

 doc/guix.texi                    | 136 ++++++++++++++++++++++---------
 gnu/build/file-systems.scm       |  35 +++++++-
 gnu/services/base.scm            | 109 +++++++++++++++++--------
 gnu/system.scm                   |  20 ++++-
 gnu/system/examples/desktop.tmpl |   7 +-
 gnu/system/file-systems.scm      |  24 +++++-
 guix/build/syscalls.scm          |  12 +++
 7 files changed, 267 insertions(+), 76 deletions(-)

-- 
2.33.1

[bug#51346] [PATCH v2 1/4] gnu: system: Rework swap space support, add dependencies.

[Josselin Poiret via Guix-patches via]

* gnu/system/file-systems.scm (swap-space): Add it.
* gnu/system.scm (operating-system)[swap-devices]: Update comment.
* gnu/services/base.scm (swap-space->shepherd-service-name,
swap-deprecated->shepherd-service-name, swap->shepherd-service-name):
Add them.
* gnu/services/base.scm (swap-service-type, swap-service): Use the new
records.
---
 gnu/services/base.scm       | 102 +++++++++++++++++++++++++-----------
 gnu/system.scm              |   2 +-
 gnu/system/file-systems.scm |  18 ++++++-
 3 files changed, 88 insertions(+), 34 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..c816381198 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -63,6 +63,8 @@ (define-module (gnu services base)
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -2146,62 +2148,98 @@ (define* (udev-rules-service name rules #:key (groups '()))
                               udev-service-type udev-extension))))))
     (service type #f)))
 
+(define (swap-space->shepherd-service-name space)
+  (let ((target (swap-space-target space)))
+    (symbol-append 'swap-
+                   (string->symbol
+                    (cond ((uuid? target)
+                           (uuid->string target))
+                          ((file-system-label? target)
+                           (file-system-label->string target))
+                          (else
+                           target))))))
+
+; TODO Remove after deprecation
+(define (swap-deprecated->shepherd-service-name sdep)
+  (symbol-append 'swap-
+                 (string->symbol
+                  (cond ((uuid? sdep)
+                         (string-take (uuid->string sdep) 6))
+                        ((file-system-label? sdep)
+                         (file-system-label->string sdep))
+                        (else
+                         sdep)))))
+
+(define swap->shepherd-service-name
+  (match-lambda ((? swap-space? space)
+                 (swap-space->shepherd-service-name space))
+                (sdep
+                 (swap-deprecated->shepherd-service-name sdep))))
+
 (define swap-service-type
   (shepherd-service-type
    'swap
-   (lambda (device)
-     (define requirement
-       (if (and (string? device)
-                (string-prefix? "/dev/mapper/" device))
-           (list (symbol-append 'device-mapping-
-                                (string->symbol (basename device))))
-           '()))
-
-     (define (device-lookup device)
+   (lambda (swap)
+     (define requirements
+       (cond ((swap-space? swap)
+              (map dependency->shepherd-service-name
+                   (swap-space-dependencies swap)))
+             ; TODO Remove after deprecation
+             ((and (string? swap) (string-prefix? "/dev/mapper/" swap))
+              (list (symbol-append 'device-mapping-
+                                   (string->symbol (basename swap)))))
+             (else
+              '())))
+
+     (define device-lookup
        ;; 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)
+       (cond ((swap-space? swap)
+              (let ((target (swap-space-target swap)))
+                (cond ((uuid? target)
+                       #~(find-partition-by-uuid #$(uuid-bytevector target)))
+                      ((file-system-label? target)
+                       #~(find-partition-by-label
+                          #$(file-system-label->string target)))
+                      (else
+                       target))))
+             ; TODO Remove after deprecation
+             ((uuid? swap)
+              #~(find-partition-by-uuid #$(uuid-bytevector swap)))
+             ((file-system-label? swap)
               #~(find-partition-by-label
-                 #$(file-system-label->string device)))
+                 #$(file-system-label->string swap)))
              (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)))))
+              swap)))
 
      (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.")
+        (provision (list (swap->shepherd-service-name swap)))
+        (requirement `(udev ,@requirements))
+        (documentation "Enable the given swap space.")
         (modules `((gnu build file-systems)
                    ,@%default-modules))
         (start #~(lambda ()
-                   (let ((device #$(device-lookup device)))
+                   (let ((device #$device-lookup))
                      (and device
                           (begin
                             (restart-on-EINTR (swapon device))
                             #t)))))
         (stop #~(lambda _
-                  (let ((device #$(device-lookup device)))
+                  (let ((device #$device-lookup))
                     (when device
                       (restart-on-EINTR (swapoff device)))
                     #f)))
         (respawn? #f))))
    (description "Turn on the virtual memory swap area.")))
 
-(define (swap-service device)
-  "Return a service that uses @var{device} as a swap device."
-  (service swap-service-type device))
+(define (swap-service swap)
+  "Return a service that uses @var{swap} as a swap space."
+  (unless (swap-space? swap)
+    (warning (G_ "Specifying swap space without @code{swap-space}
+is deprecated, see \"(guix) operating-system Reference\" for
+more details.~%")))
+  (service swap-service-type swap))
 
 (define %default-gpm-options
   ;; Default options for GPM.
diff --git a/gnu/system.scm b/gnu/system.scm
index 58b594694a..2797c07e36 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -234,7 +234,7 @@ (define-record-type* <operating-system> operating-system
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
                   (default '()))
   (file-systems operating-system-file-systems)    ; list of fs
-  (swap-devices operating-system-swap-devices     ; list of strings
+  (swap-devices operating-system-swap-devices     ; list of string | <swap-space>
                 (default '()))
 
   (users operating-system-users                   ; list of user accounts
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index e69cfd06e6..7aa19069a1 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -96,7 +96,12 @@ (define-module (gnu system file-systems)
 
             %store-mapping
             %network-configuration-files
-            %network-file-mappings))
+            %network-file-mappings
+
+            swap-space
+            swap-space?
+            swap-space-target
+            swap-space-dependencies))
 
 ;;; Commentary:
 ;;;
@@ -671,4 +676,15 @@ (define (prepend-slash/maybe s)
                   (G_ "Use the @code{subvol} Btrfs file system option."))))))))
 
 
+;;;
+;;; Swap space
+;;;
+
+(define-record-type* <swap-space> swap-space make-swap-space
+  swap-space?
+  this-swap-space
+  (target swap-space-target)
+  (dependencies swap-space-dependencies
+                (default '())))
+
 ;;; file-systems.scm ends here
-- 
2.33.1

[bug#51346] [PATCH v2 2/4] gnu: system: Add swap flags.

[Josselin Poiret via Guix-patches via]

* gnu/system/file-systems.scm (swap-space)[priority, discard?]: Add
them.
* guix/build/syscalls.scm (SWAP_FLAG_PREFER, SWAP_FLAG_PRIO_MASK,
SWAP_FLAG_PRIO_SHIFT, SWAP_FLAG_DISCARD): Add them.
* gnu/build/file-systems.scm (swap-space->flags-bit-mask): Add it.
* gnu/services/base.scm (swap-service-type): Use it.
---
 gnu/build/file-systems.scm  | 35 ++++++++++++++++++++++++++++++++++-
 gnu/services/base.scm       |  7 +++++--
 gnu/system/file-systems.scm | 10 ++++++++--
 guix/build/syscalls.scm     | 12 ++++++++++++
 4 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index d8a5ddf1e5..39a408e8c1 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -29,6 +29,8 @@ (define-module (gnu build file-systems)
   #:use-module (guix build bournish)
   #:use-module ((guix build syscalls)
                 #:hide (file-system-type))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -54,7 +56,9 @@ (define-module (gnu build file-systems)
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system))
+            mount-file-system
+
+            swap-space->flags-bit-mask))
 
 ;;; Commentary:
 ;;;
@@ -227,6 +231,35 @@ (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)))
+
+(define (swap-space->flags-bit-mask swap)
+  "Return the number suitable for the 'flags' argument of 'mount'
+that corresponds to the swap-space SWAP."
+  (define prio-flag
+    (let ((p (swap-space-priority swap))
+	  (max (ash SWAP_FLAG_PRIO_MASK (- SWAP_FLAG_PRIO_SHIFT))))
+      (if p
+	  (logior SWAP_FLAG_PREFER
+		  (ash (cond
+		   ((< p 0)
+		    (begin (warning
+			    (G_ "Given swap priority ~a is negative,
+defaulting to 0.~%") p)
+			   0))
+		   ((> p max)
+		    (begin (warning
+			    (G_ "Limiting swap priority ~a to ~a.~%")
+				p max)
+			   max))
+		   (else p))
+		       SWAP_FLAG_PRIO_SHIFT))
+	  0)))
+  (define delayed-flag
+    (if (swap-space-discard? swap)
+	SWAP_FLAG_DISCARD
+	0))
+  (logior prio-flag delayed-flag))
+
 \f
 
 ;;;
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c816381198..cf43a78fd0 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -58,7 +58,8 @@ (define-module (gnu services base)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
-                #:select (mount-flags->bit-mask))
+                #:select (mount-flags->bit-mask
+			  swap-space->flags-bit-mask))
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
@@ -2223,7 +2224,9 @@ (define device-lookup
                    (let ((device #$device-lookup))
                      (and device
                           (begin
-                            (restart-on-EINTR (swapon device))
+                            (restart-on-EINTR (swapon device
+						      #$(swap-space->flags-bit-mask
+							 swap)))
                             #t)))))
         (stop #~(lambda _
                   (let ((device #$device-lookup))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 7aa19069a1..fba4ebf65d 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -101,7 +101,9 @@ (define-module (gnu system file-systems)
             swap-space
             swap-space?
             swap-space-target
-            swap-space-dependencies))
+            swap-space-dependencies
+	    swap-space-priority
+	    swap-space-discard?))
 
 ;;; Commentary:
 ;;;
@@ -685,6 +687,10 @@ (define-record-type* <swap-space> swap-space make-swap-space
   this-swap-space
   (target swap-space-target)
   (dependencies swap-space-dependencies
-                (default '())))
+                (default '()))
+  (priority swap-space-priority
+	    (default #f))
+  (discard? swap-space-discard?
+	   (default #f)))
 
 ;;; file-systems.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 99a3b45004..f2b18abf5a 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -71,6 +71,11 @@ (define-module (guix build syscalls)
             mounts
             mount-points
 
+            SWAP_FLAG_PREFER
+            SWAP_FLAG_PRIO_MASK
+            SWAP_FLAG_PRIO_SHIFT
+            SWAP_FLAG_DISCARD
+
             swapon
             swapoff
 
@@ -677,6 +682,13 @@ (define (mount-points)
   "Return the mounts points for currently mounted file systems."
   (map mount-point (mounts)))
 
+;; Pulled from glibc's sysdeps/unix/sysv/linux/sys/swap.h
+
+(define SWAP_FLAG_PREFER     #x8000) ;; Set if swap priority is specified.
+(define SWAP_FLAG_PRIO_MASK  #x7fff)
+(define SWAP_FLAG_PRIO_SHIFT 0)
+(define SWAP_FLAG_DISCARD    #x10000) ;; Discard swap cluster after use.
+
 (define swapon
   (let ((proc (syscall->procedure int "swapon" (list '* int))))
     (lambda* (device #:optional (flags 0))
-- 
2.33.1

[bug#51346] [PATCH v2 3/4] gnu: system: Filter out boot dependencies from swap-space.

[Josselin Poiret via Guix-patches via]

* gnu/systems.scm (swap-services): Filter them.
---
 gnu/system.scm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 2797c07e36..e3accb3c1e 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -586,7 +586,23 @@ (define (device-mapping-services os)
 
 (define (swap-services os)
   "Return the list of swap services for OS."
-  (map swap-service (operating-system-swap-devices os)))
+  (define early-userspace-file-systems
+    (filter file-system-needed-for-boot?
+            (operating-system-file-systems os)))
+
+  (define early-userspace-mapped-devices
+    (operating-system-boot-mapped-devices os))
+
+  (define (filter-deps swap)
+    (swap-space
+     (inherit swap)
+     (dependencies (remove (lambda (dep)
+			     (or (member dep early-userspace-mapped-devices)
+				 (member dep early-userspace-file-systems)))
+			   (swap-space-dependencies swap)))))
+
+  (map (compose swap-service filter-deps)
+       (operating-system-swap-devices os)))
 
 (define* (system-linux-image-file-name #:optional
                                        (target (or (%current-target-system)
-- 
2.33.1

[bug#51346] [PATCH v2 4/4] doc: Add new Swap Space section.

[Josselin Poiret via Guix-patches via]

* doc/guix.texi (operating-system Reference): Update swap-devices.
* doc/guix.texi (Swap Space): Add it.
* gnu/system/examples/desktop.tmpl: Add swap-devices example.
---
 doc/guix.texi                    | 136 ++++++++++++++++++++++---------
 gnu/system/examples/desktop.tmpl |   7 +-
 2 files changed, 105 insertions(+), 38 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 67a05a10ff..2cf30536fe 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -319,6 +319,7 @@ System Configuration
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Backing RAM with disk space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -2515,10 +2516,9 @@ system relative to this path.  If you have opted for @file{/boot/efi} as an
 EFI mount point for example, mount it at @file{/mnt/boot/efi} now so it is
 found by @code{guix system init} afterwards.
 
-Finally, if you plan to use one or more swap partitions (@pxref{Memory
-Concepts, swap space,, libc, The GNU C Library Reference Manual}), make
-sure to initialize them with @command{mkswap}.  Assuming you have one
-swap partition on @file{/dev/sda3}, you would run:
+Finally, if you plan to use one or more swap partitions (@pxref{Swap
+Space}), make sure to initialize them with @command{mkswap}.  Assuming
+you have one swap partition on @file{/dev/sda3}, you would run:
 
 @example
 mkswap /dev/sda3
@@ -13769,6 +13769,7 @@ instance to support new system services.
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Backing RAM with disk space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -13937,7 +13938,7 @@ configuration, but with a few modifications.
 
 @cindex encrypted disk
 The configuration for a typical ``desktop'' usage, with an encrypted
-root partition, the X11 display
+root partition, a swap file on the root partition, the X11 display
 server, GNOME and Xfce (users can choose which of these desktop
 environments to use at the log-in screen by pressing @kbd{F1}), network
 management, power management, and more, would look like this:
@@ -14135,38 +14136,9 @@ A list of mapped devices.  @xref{Mapped Devices}.
 @item @code{file-systems}
 A list of file systems.  @xref{File Systems}.
 
-@cindex swap devices
-@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}).  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 (under @file{/dev/mapper}), provided that the necessary device
-mapping and file system are also specified.  @xref{Mapped Devices} and
-@ref{File Systems}.
+@cindex swap devices
+A list of swap spaces.  @xref{Swap Space}.
 
 @item @code{users} (default: @code{%base-user-accounts})
 @itemx @code{groups} (default: @code{%base-groups})
@@ -14756,7 +14728,8 @@ It is also desirable to encrypt swap space, since swap space may contain
 sensitive data.  One way to accomplish that is to use a swap file in a
 file system on a device mapped via LUKS encryption.  In this way, the
 swap file is encrypted because the entire device is encrypted.
-@xref{Preparing for Installation,,Disk Partitioning}, for an example.
+@xref{Swap Space}, or @xref{Preparing for Installation,,Disk
+Partitioning}, for an example.
 
 A RAID device formed of the partitions @file{/dev/sda1} and @file{/dev/sdb1}
 may be declared as follows:
@@ -14788,6 +14761,95 @@ Devices @file{/dev/mapper/vg0-alpha} and @file{/dev/mapper/vg0-beta} can
 then be used as the @code{device} of a @code{file-system} declaration
 (@pxref{File Systems}).
 
+@node Swap Space
+@section Swap Space
+@cindex swap space
+
+Swap space, as it is commonly called, is a disk area specifically
+designated for paging: the process in charge of memory management
+(the Linux kernel or Hurd's default pager) can decide that some memory
+pages stored in RAM which belong to a running program but are unused
+should be stored on disk instead.  It unloads those from the RAM,
+freeing up precious fast memory, and writes them to the swap space.  If
+the program tries to access that very page, the memory management
+process loads it back into memory for the program to use.
+
+A common misconception about swap is that it is only useful when small
+amounts of RAM are available to the system.  However, it should be noted
+that kernels often use all available RAM for disk access caching to make
+I/O faster, and thus paging out unused portions of program memory will
+expand the RAM available for such caching.
+
+For a more detailed description of how memory is managed from the
+viewpoint of a monolithic kernel, @xref{Memory
+Concepts,,, libc, The GNU C Library Reference Manual}.
+
+The Linux kernel has support for swap partitions and swap files: the
+former uses a whole disk partition for paging, whereas the second uses a
+file on a file system for that (the file system driver needs to support
+it).  On a comparable setup, both have the same performance, so one
+should consider ease of use when deciding between them.  Partitions are
+``simpler'' and do not need file system support, but need to be
+allocated at disk formatting time (logical volumes notwithstanding),
+whereas files can be allocated and deallocated at any time.
+
+Note that swap space is not zeroed on shutdown, so sensitive data (such
+as passwords) may linger on it if it was paged out.  As such, you should
+consider having your swap reside on an encrypted device (@pxref{Mapped
+Devices}).
+
+@deftp {Data Type} swap-space
+Objects of this type represent swap spaces.  They contain the following
+members:
+
+@table @asis
+@item @code{target}
+The device or file to use, either a UUID, a @code{file-system-label} or
+a string, as in the definition of a @code{file-system} (@pxref{File
+Systems}).
+
+@item @code{dependencies} (default: @code{'()})
+A list of @code{file-system} or @code{mapped-device} objects, upon which
+the availability of the space depends.  Note that just like for
+@code{file-system} objects, dependencies which are needed for boot and
+mounted in early userspace are not managed by the Shepherd, and so
+automatically filtered out for you.
+
+@item @code{priority} (default: @code{#f})
+Only supported by the Linux kernel.  Either @code{#f} to disable swap
+priority, or an integer between 0 and 32767.  The kernel will first use
+swap spaces of higher priority when paging, and use same priority spaces
+on a round-robin basis.  The kernel will use swap spaces without a set
+priority after prioritized spaces, and in the order that they appeared in
+(not round-robin).
+
+@item @code{discard?} (default: @code{#f})
+Only supported by the Linux kernel.  When true, the kernel will notify
+the disk controller of discarded pages, for example with the TRIM
+operation on Solid State Drives.
+
+@end table
+@end deftp
+
+Here are some examples:
+
+@table @code
+@item (swap-space (target (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 (swap-space (target (file-system-label "swap")) (dependencies (list lvm-device)))
+Use the partition with label @code{swap}, which can be found after the
+@var{lvm-device} mapped device has been opened.  Again, the
+@command{swaplabel} command allows you to view and change the label of a
+Linux swap partition.
+
+@item (swap-space (target "/btrfs/swapfile") (dependencies (list btrfs-fs)))
+Use the file @file{/btrfs/swapfile} as swap space, which is present on the
+@var{btrfs-fs} filesystem.
+@end table
+
 @node User Accounts
 @section User Accounts
 
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index c928008c92..93c35a03bc 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -1,6 +1,6 @@
 ;; This is an operating system configuration template
 ;; for a "desktop" setup with GNOME and Xfce where the
-;; root partition is encrypted with LUKS.
+;; root partition is encrypted with LUKS, and a swap file.
 
 (use-modules (gnu) (gnu system nss))
 (use-service-modules desktop xorg)
@@ -42,6 +42,11 @@
                          (type "vfat")))
                  %base-file-systems))
 
+  ;; Specify a swap file for the system, which resides on the
+  ;; root file system.
+  (swap-devices (list (swap-space
+		       (target "/swapfile"))))
+
   ;; Create user `bob' with `alice' as its initial password.
   (users (cons (user-account
                 (name "bob")
-- 
2.33.1

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Ludovic Courtès]

Hi,

Josselin Poiret <dev@jpoiret.xyz> skribis:

> * gnu/system/file-systems.scm (swap-space): Add it.
> * gnu/system.scm (operating-system)[swap-devices]: Update comment.
> * gnu/services/base.scm (swap-space->shepherd-service-name,
> swap-deprecated->shepherd-service-name, swap->shepherd-service-name):
> Add them.
> * gnu/services/base.scm (swap-service-type, swap-service): Use the new
> records.

Nice, LGTM!

I would tend to merge the doc patch (#4) with this one, but not big
deal.

Ludo’.

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Ludovic Courtès]

Josselin Poiret <dev@jpoiret.xyz> skribis:

> * gnu/system/file-systems.scm (swap-space)[priority, discard?]: Add
> them.
> * guix/build/syscalls.scm (SWAP_FLAG_PREFER, SWAP_FLAG_PRIO_MASK,
> SWAP_FLAG_PRIO_SHIFT, SWAP_FLAG_DISCARD): Add them.
> * gnu/build/file-systems.scm (swap-space->flags-bit-mask): Add it.
> * gnu/services/base.scm (swap-service-type): Use it.

[...]

>                     (let ((device #$device-lookup))
>                       (and device
>                            (begin
> -                            (restart-on-EINTR (swapon device))
> +                            (restart-on-EINTR (swapon device
> +						      #$(swap-space->flags-bit-mask
> +							 swap)))

Note for later: IWBN to have a ‘sanitize’ field in <swap-space> that
checks the flags, similar to commit 5eb5c0789f34e87ee417a53ddfcfa3b6521bb337.

> -            swap-space-dependencies))
> +            swap-space-dependencies
> +	    swap-space-priority
> +	    swap-space-discard?))

Please don’t use tabs at all in Scheme code.

LGTM!

Ludo’.

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Ludovic Courtès]

Josselin Poiret <dev@jpoiret.xyz> skribis:

> * doc/guix.texi (operating-system Reference): Update swap-devices.
> * doc/guix.texi (Swap Space): Add it.
> * gnu/system/examples/desktop.tmpl: Add swap-devices example.

[...]

> +Here are some examples:
> +
> +@table @code
> +@item (swap-space (target (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 (swap-space (target (file-system-label "swap")) (dependencies (list lvm-device)))

Could you get rid of the table here, and instead write examples in @lisp
blocks?

Otherwise LGTM.

Ludo’.

[bug#51346] [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Ludovic Courtès]

Josselin Poiret <dev@jpoiret.xyz> skribis:

> +   (lambda (swap)
> +     (define requirements
> +       (cond ((swap-space? swap)
> +              (map dependency->shepherd-service-name
> +                   (swap-space-dependencies swap)))
> +             ; TODO Remove after deprecation
> +             ((and (string? swap) (string-prefix? "/dev/mapper/" swap))
> +              (list (symbol-append 'device-mapping-
> +                                   (string->symbol (basename swap)))))

BTW, shouldn’t we emit a deprecation warning when (string? swap)?

If we do, it should contain source location info, as discussed at
<https://lists.gnu.org/archive/html/guix-devel/2021-09/msg00314.html>.

The whole series LGTM modulo the minor issues I commented on; could you
send a last version?

If Tobias agrees, we can apply that last version as soon as we get it.
I’d even apply it to ‘master’; why did you target ‘core-updates-frozen’?

Thanks!

Ludo’.

[bug#51346] [PATCH v3 0/5] Rework swap device to add dependencies and flags

[Josselin Poiret via Guix-patches via]

Hello Tobias and Ludovic,

Thanks for the review!  Here is hopefully the last patchset, which
addresses most of the issues.

I decided not to merge the doc changes with the first commit as it
also describes swap flags, but that's just a matter of taste I
suppose.

Moved the deprecation warning that I originally put in
gnu/services/base.scm (swap-service) to a sanitizer of swap-devices in
its own commit, although it only reports the location of the
(operating-system) syntax use, not of the field itself (but that is
what I also noticed for other deprecation warnings, alas).  I marked
the field as delayed, otherwise I was getting a lot of warnings while
testing rather than the only one I'm getting now.

Fixed the swap-device dependency filtering to silently ignore
old-style values rather than erroring out.

Overall, I cleaned up all the rogue TABs I had inserted!
(setq-default indent-tabs-mode nil) for our Emacs readers at home.
This should not happen any more as I have set whitespace-mode to an
aggressive red highlighting for TAB characters.

And finally, I changed the examples at the end to simply be @lisp
blocks, outside of a table.

Josselin Poiret (5):
  gnu: system: Rework swap space support, add dependencies.
  gnu: system: Warn about swap-devices format change
  gnu: system: Add swap flags.
  gnu: system: Filter out boot dependencies from swap-space.
  doc: Add new Swap Space section.

 doc/guix.texi                    | 147 +++++++++++++++++++++++--------
 gnu/build/file-systems.scm       |  36 +++++++-
 gnu/services/base.scm            | 105 +++++++++++++++-------
 gnu/system.scm                   |  40 ++++++++-
 gnu/system/examples/desktop.tmpl |   7 +-
 gnu/system/file-systems.scm      |  24 ++++-
 guix/build/syscalls.scm          |  12 +++
 7 files changed, 294 insertions(+), 77 deletions(-)

-- 
2.33.1

[bug#51346] [PATCH v3 1/5] gnu: system: Rework swap space support, add dependencies.

[Josselin Poiret via Guix-patches via]

* gnu/system/file-systems.scm (swap-space): Add it.
* gnu/system.scm (operating-system)[swap-devices]: Update comment.
* gnu/services/base.scm (swap-space->shepherd-service-name,
swap-deprecated->shepherd-service-name, swap->shepherd-service-name):
Add them.
* gnu/services/base.scm (swap-service-type, swap-service): Use the new
records.
---
 gnu/services/base.scm       | 98 +++++++++++++++++++++++++------------
 gnu/system.scm              |  4 +-
 gnu/system/file-systems.scm | 18 ++++++-
 3 files changed, 85 insertions(+), 35 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 50865055fe..35f38c7e09 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -63,6 +63,8 @@ (define-module (gnu services base)
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
@@ -2146,62 +2148,94 @@ (define* (udev-rules-service name rules #:key (groups '()))
                               udev-service-type udev-extension))))))
     (service type #f)))
 
+(define (swap-space->shepherd-service-name space)
+  (let ((target (swap-space-target space)))
+    (symbol-append 'swap-
+                   (string->symbol
+                    (cond ((uuid? target)
+                           (uuid->string target))
+                          ((file-system-label? target)
+                           (file-system-label->string target))
+                          (else
+                           target))))))
+
+; TODO Remove after deprecation
+(define (swap-deprecated->shepherd-service-name sdep)
+  (symbol-append 'swap-
+                 (string->symbol
+                  (cond ((uuid? sdep)
+                         (string-take (uuid->string sdep) 6))
+                        ((file-system-label? sdep)
+                         (file-system-label->string sdep))
+                        (else
+                         sdep)))))
+
+(define swap->shepherd-service-name
+  (match-lambda ((? swap-space? space)
+                 (swap-space->shepherd-service-name space))
+                (sdep
+                 (swap-deprecated->shepherd-service-name sdep))))
+
 (define swap-service-type
   (shepherd-service-type
    'swap
-   (lambda (device)
-     (define requirement
-       (if (and (string? device)
-                (string-prefix? "/dev/mapper/" device))
-           (list (symbol-append 'device-mapping-
-                                (string->symbol (basename device))))
-           '()))
-
-     (define (device-lookup device)
+   (lambda (swap)
+     (define requirements
+       (cond ((swap-space? swap)
+              (map dependency->shepherd-service-name
+                   (swap-space-dependencies swap)))
+             ; TODO Remove after deprecation
+             ((and (string? swap) (string-prefix? "/dev/mapper/" swap))
+              (list (symbol-append 'device-mapping-
+                                   (string->symbol (basename swap)))))
+             (else
+              '())))
+
+     (define device-lookup
        ;; 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)
+       (cond ((swap-space? swap)
+              (let ((target (swap-space-target swap)))
+                (cond ((uuid? target)
+                       #~(find-partition-by-uuid #$(uuid-bytevector target)))
+                      ((file-system-label? target)
+                       #~(find-partition-by-label
+                          #$(file-system-label->string target)))
+                      (else
+                       target))))
+             ; TODO Remove after deprecation
+             ((uuid? swap)
+              #~(find-partition-by-uuid #$(uuid-bytevector swap)))
+             ((file-system-label? swap)
               #~(find-partition-by-label
-                 #$(file-system-label->string device)))
+                 #$(file-system-label->string swap)))
              (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)))))
+              swap)))
 
      (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.")
+        (provision (list (swap->shepherd-service-name swap)))
+        (requirement `(udev ,@requirements))
+        (documentation "Enable the given swap space.")
         (modules `((gnu build file-systems)
                    ,@%default-modules))
         (start #~(lambda ()
-                   (let ((device #$(device-lookup device)))
+                   (let ((device #$device-lookup))
                      (and device
                           (begin
                             (restart-on-EINTR (swapon device))
                             #t)))))
         (stop #~(lambda _
-                  (let ((device #$(device-lookup device)))
+                  (let ((device #$device-lookup))
                     (when device
                       (restart-on-EINTR (swapoff device)))
                     #f)))
         (respawn? #f))))
    (description "Turn on the virtual memory swap area.")))
 
-(define (swap-service device)
-  "Return a service that uses @var{device} as a swap device."
-  (service swap-service-type device))
+(define (swap-service swap)
+  "Return a service that uses @var{swap} as a swap space."
+  (service swap-service-type swap))
 
 (define %default-gpm-options
   ;; Default options for GPM.
diff --git a/gnu/system.scm b/gnu/system.scm
index 17653682c5..fd556e1e7c 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -233,8 +233,8 @@ (define-record-type* <operating-system> operating-system
   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
                   (default '()))
   (file-systems operating-system-file-systems)    ; list of fs
-  (swap-devices operating-system-swap-devices     ; list of strings
-                (default '()))
+  (swap-devices operating-system-swap-devices     ; list of string | <swap-space>
+                (default '())
 
   (users operating-system-users                   ; list of user accounts
          (default %base-user-accounts))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index c6c1b96d16..027df7e966 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -97,7 +97,12 @@ (define-module (gnu system file-systems)
 
             %store-mapping
             %network-configuration-files
-            %network-file-mappings))
+            %network-file-mappings
+
+            swap-space
+            swap-space?
+            swap-space-target
+            swap-space-dependencies))
 
 ;;; Commentary:
 ;;;
@@ -712,4 +717,15 @@ (define (prepend-slash/maybe s)
                   (G_ "Use the @code{subvol} Btrfs file system option."))))))))
 
 
+;;;
+;;; Swap space
+;;;
+
+(define-record-type* <swap-space> swap-space make-swap-space
+  swap-space?
+  this-swap-space
+  (target swap-space-target)
+  (dependencies swap-space-dependencies
+                (default '())))
+
 ;;; file-systems.scm ends here
-- 
2.33.1

[bug#51346] [PATCH v3 2/5] gnu: system: Warn about swap-devices format change

[Josselin Poiret via Guix-patches via]

* gnu/system.scm (warn-swap-devices-change,
%warn-swap-devices-change): Add them.
* gnu/system.scm (operating-system) [swap-devices]: Use it.
---
 gnu/system.scm | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/gnu/system.scm b/gnu/system.scm
index fd556e1e7c..76a904b681 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -235,6 +235,8 @@ (define-record-type* <operating-system> operating-system
   (file-systems operating-system-file-systems)    ; list of fs
   (swap-devices operating-system-swap-devices     ; list of string | <swap-space>
                 (default '())
+                (delayed)
+                (sanitize warn-swap-devices-change))
 
   (users operating-system-users                   ; list of user accounts
          (default %base-user-accounts))
@@ -583,6 +585,20 @@ (define (device-mapping-services os)
   (map device-mapping-service
        (operating-system-user-mapped-devices os)))
 
+(define-syntax-rule (warn-swap-devices-change value)
+  (%warn-swap-devices-change value (current-source-location)))
+
+(define (%warn-swap-devices-change value location)
+  (map (lambda (x)
+         (unless (swap-space? x)
+           (warning
+            (source-properties->location
+             location)
+            (G_ "List elements of the field 'swap-devices' should \
+now use the <swap-space> record, as the old method is deprecated. \
+See \"(guix) operating-system Reference\" for more details.~%")))
+         x) value))
+
 (define (swap-services os)
   "Return the list of swap services for OS."
   (map swap-service (operating-system-swap-devices os)))
-- 
2.33.1

[bug#51346] [PATCH v3 3/5] gnu: system: Add swap flags.

[Josselin Poiret via Guix-patches via]

* gnu/system/file-systems.scm (swap-space)[priority, discard?]: Add
them.
* guix/build/syscalls.scm (SWAP_FLAG_PREFER, SWAP_FLAG_PRIO_MASK,
SWAP_FLAG_PRIO_SHIFT, SWAP_FLAG_DISCARD): Add them.
* gnu/build/file-systems.scm (swap-space->flags-bit-mask): Add it.
* gnu/services/base.scm (swap-service-type): Use it.
---
 gnu/build/file-systems.scm  | 36 +++++++++++++++++++++++++++++++++++-
 gnu/services/base.scm       |  7 +++++--
 gnu/system/file-systems.scm | 10 ++++++++--
 guix/build/syscalls.scm     | 12 ++++++++++++
 4 files changed, 60 insertions(+), 5 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index d8a5ddf1e5..d95340df83 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -29,6 +29,8 @@ (define-module (gnu build file-systems)
   #:use-module (guix build bournish)
   #:use-module ((guix build syscalls)
                 #:hide (file-system-type))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (rnrs io ports)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
@@ -54,7 +56,9 @@ (define-module (gnu build file-systems)
 
             mount-flags->bit-mask
             check-file-system
-            mount-file-system))
+            mount-file-system
+
+            swap-space->flags-bit-mask))
 
 ;;; Commentary:
 ;;;
@@ -227,6 +231,36 @@ (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)))
+
+(define (swap-space->flags-bit-mask swap)
+  "Return the number suitable for the 'flags' argument of 'mount'
+that corresponds to the swap-space SWAP."
+  (define prio-flag
+    (let ((p (swap-space-priority swap))
+          (max (ash SWAP_FLAG_PRIO_MASK (- SWAP_FLAG_PRIO_SHIFT))))
+      (if p
+          (logior SWAP_FLAG_PREFER
+                  (ash (cond
+                        ((< p 0)
+                         (begin (warning
+                                 (G_ "Given swap priority ~a is
+negative, defaulting to 0.~%") p)
+                                0))
+                        ((> p max)
+                         (begin (warning
+                                 (G_ "Limiting swap priority ~a to
+~a.~%")
+                                 p max)
+                                max))
+                        (else p))
+                       SWAP_FLAG_PRIO_SHIFT))
+          0)))
+  (define delayed-flag
+    (if (swap-space-discard? swap)
+        SWAP_FLAG_DISCARD
+        0))
+  (logior prio-flag delayed-flag))
+
 \f
 
 ;;;
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 35f38c7e09..20736eb13f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -58,7 +58,8 @@ (define-module (gnu services base)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
-                #:select (mount-flags->bit-mask))
+                #:select (mount-flags->bit-mask
+                          swap-space->flags-bit-mask))
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix modules)
@@ -2223,7 +2224,9 @@ (define device-lookup
                    (let ((device #$device-lookup))
                      (and device
                           (begin
-                            (restart-on-EINTR (swapon device))
+                            (restart-on-EINTR (swapon device
+                                                      #$(swap-space->flags-bit-mask
+                                                         swap)))
                             #t)))))
         (stop #~(lambda _
                   (let ((device #$device-lookup))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 027df7e966..e1d1fb72cc 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -102,7 +102,9 @@ (define-module (gnu system file-systems)
             swap-space
             swap-space?
             swap-space-target
-            swap-space-dependencies))
+            swap-space-dependencies
+            swap-space-priority
+            swap-space-discard?))
 
 ;;; Commentary:
 ;;;
@@ -726,6 +728,10 @@ (define-record-type* <swap-space> swap-space make-swap-space
   this-swap-space
   (target swap-space-target)
   (dependencies swap-space-dependencies
-                (default '())))
+                (default '()))
+  (priority swap-space-priority
+            (default #f))
+  (discard? swap-space-discard?
+           (default #f)))
 
 ;;; file-systems.scm ends here
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index b305133c37..63bd017d1d 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -71,6 +71,11 @@ (define-module (guix build syscalls)
             mounts
             mount-points
 
+            SWAP_FLAG_PREFER
+            SWAP_FLAG_PRIO_MASK
+            SWAP_FLAG_PRIO_SHIFT
+            SWAP_FLAG_DISCARD
+
             swapon
             swapoff
 
@@ -685,6 +690,13 @@ (define (mount-points)
   "Return the mounts points for currently mounted file systems."
   (map mount-point (mounts)))
 
+;; Pulled from glibc's sysdeps/unix/sysv/linux/sys/swap.h
+
+(define SWAP_FLAG_PREFER     #x8000) ;; Set if swap priority is specified.
+(define SWAP_FLAG_PRIO_MASK  #x7fff)
+(define SWAP_FLAG_PRIO_SHIFT 0)
+(define SWAP_FLAG_DISCARD    #x10000) ;; Discard swap cluster after use.
+
 (define swapon
   (let ((proc (syscall->procedure int "swapon" (list '* int))))
     (lambda* (device #:optional (flags 0))
-- 
2.33.1

[bug#51346] [PATCH v3 4/5] gnu: system: Filter out boot dependencies from swap-space.

[Josselin Poiret via Guix-patches via]

* gnu/systems.scm (swap-services): Filter them.
---
 gnu/system.scm | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index 76a904b681..03fb55db15 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -601,7 +601,25 @@ (define (%warn-swap-devices-change value location)
 
 (define (swap-services os)
   "Return the list of swap services for OS."
-  (map swap-service (operating-system-swap-devices os)))
+  (define early-userspace-file-systems
+    (filter file-system-needed-for-boot?
+            (operating-system-file-systems os)))
+
+  (define early-userspace-mapped-devices
+    (operating-system-boot-mapped-devices os))
+
+  (define (filter-deps swap)
+    (if (swap-space? swap)
+        (swap-space
+         (inherit swap)
+         (dependencies (remove (lambda (dep)
+                                 (or (member dep early-userspace-mapped-devices)
+                                     (member dep early-userspace-file-systems)))
+                               (swap-space-dependencies swap))))
+        swap))
+
+  (map (compose swap-service filter-deps)
+       (operating-system-swap-devices os)))
 
 (define* (system-linux-image-file-name #:optional
                                        (target (or (%current-target-system)
-- 
2.33.1

[bug#51346] [PATCH v3 5/5] doc: Add new Swap Space section.

[Josselin Poiret via Guix-patches via]

* doc/guix.texi (operating-system Reference): Update swap-devices.
* doc/guix.texi (Swap Space): Add it.
* gnu/system/examples/desktop.tmpl: Add swap-devices example.
---
 doc/guix.texi                    | 147 +++++++++++++++++++++++--------
 gnu/system/examples/desktop.tmpl |   7 +-
 2 files changed, 116 insertions(+), 38 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 95d286a836..6838a3691f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -320,6 +320,7 @@ System Configuration
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Backing RAM with disk space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -2527,10 +2528,9 @@ system relative to this path.  If you have opted for @file{/boot/efi} as an
 EFI mount point for example, mount it at @file{/mnt/boot/efi} now so it is
 found by @code{guix system init} afterwards.
 
-Finally, if you plan to use one or more swap partitions (@pxref{Memory
-Concepts, swap space,, libc, The GNU C Library Reference Manual}), make
-sure to initialize them with @command{mkswap}.  Assuming you have one
-swap partition on @file{/dev/sda3}, you would run:
+Finally, if you plan to use one or more swap partitions (@pxref{Swap
+Space}), make sure to initialize them with @command{mkswap}.  Assuming
+you have one swap partition on @file{/dev/sda3}, you would run:
 
 @example
 mkswap /dev/sda3
@@ -14012,6 +14012,7 @@ instance to support new system services.
 * operating-system Reference::  Detail of operating-system declarations.
 * File Systems::                Configuring file system mounts.
 * Mapped Devices::              Block device extra processing.
+* Swap Space::                  Backing RAM with disk space.
 * User Accounts::               Specifying user accounts.
 * Keyboard Layout::             How the system interprets key strokes.
 * Locales::                     Language and cultural convention settings.
@@ -14180,7 +14181,7 @@ configuration, but with a few modifications.
 
 @cindex encrypted disk
 The configuration for a typical ``desktop'' usage, with an encrypted
-root partition, the X11 display
+root partition, a swap file on the root partition, the X11 display
 server, GNOME and Xfce (users can choose which of these desktop
 environments to use at the log-in screen by pressing @kbd{F1}), network
 management, power management, and more, would look like this:
@@ -14378,38 +14379,9 @@ A list of mapped devices.  @xref{Mapped Devices}.
 @item @code{file-systems}
 A list of file systems.  @xref{File Systems}.
 
-@cindex swap devices
-@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}).  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 (under @file{/dev/mapper}), provided that the necessary device
-mapping and file system are also specified.  @xref{Mapped Devices} and
-@ref{File Systems}.
+@cindex swap devices
+A list of swap spaces.  @xref{Swap Space}.
 
 @item @code{users} (default: @code{%base-user-accounts})
 @itemx @code{groups} (default: @code{%base-groups})
@@ -14999,7 +14971,8 @@ It is also desirable to encrypt swap space, since swap space may contain
 sensitive data.  One way to accomplish that is to use a swap file in a
 file system on a device mapped via LUKS encryption.  In this way, the
 swap file is encrypted because the entire device is encrypted.
-@xref{Preparing for Installation,,Disk Partitioning}, for an example.
+@xref{Swap Space}, or @xref{Preparing for Installation,,Disk
+Partitioning}, for an example.
 
 A RAID device formed of the partitions @file{/dev/sda1} and @file{/dev/sdb1}
 may be declared as follows:
@@ -15031,6 +15004,106 @@ Devices @file{/dev/mapper/vg0-alpha} and @file{/dev/mapper/vg0-beta} can
 then be used as the @code{device} of a @code{file-system} declaration
 (@pxref{File Systems}).
 
+@node Swap Space
+@section Swap Space
+@cindex swap space
+
+Swap space, as it is commonly called, is a disk area specifically
+designated for paging: the process in charge of memory management
+(the Linux kernel or Hurd's default pager) can decide that some memory
+pages stored in RAM which belong to a running program but are unused
+should be stored on disk instead.  It unloads those from the RAM,
+freeing up precious fast memory, and writes them to the swap space.  If
+the program tries to access that very page, the memory management
+process loads it back into memory for the program to use.
+
+A common misconception about swap is that it is only useful when small
+amounts of RAM are available to the system.  However, it should be noted
+that kernels often use all available RAM for disk access caching to make
+I/O faster, and thus paging out unused portions of program memory will
+expand the RAM available for such caching.
+
+For a more detailed description of how memory is managed from the
+viewpoint of a monolithic kernel, @xref{Memory
+Concepts,,, libc, The GNU C Library Reference Manual}.
+
+The Linux kernel has support for swap partitions and swap files: the
+former uses a whole disk partition for paging, whereas the second uses a
+file on a file system for that (the file system driver needs to support
+it).  On a comparable setup, both have the same performance, so one
+should consider ease of use when deciding between them.  Partitions are
+``simpler'' and do not need file system support, but need to be
+allocated at disk formatting time (logical volumes notwithstanding),
+whereas files can be allocated and deallocated at any time.
+
+Note that swap space is not zeroed on shutdown, so sensitive data (such
+as passwords) may linger on it if it was paged out.  As such, you should
+consider having your swap reside on an encrypted device (@pxref{Mapped
+Devices}).
+
+@deftp {Data Type} swap-space
+Objects of this type represent swap spaces.  They contain the following
+members:
+
+@table @asis
+@item @code{target}
+The device or file to use, either a UUID, a @code{file-system-label} or
+a string, as in the definition of a @code{file-system} (@pxref{File
+Systems}).
+
+@item @code{dependencies} (default: @code{'()})
+A list of @code{file-system} or @code{mapped-device} objects, upon which
+the availability of the space depends.  Note that just like for
+@code{file-system} objects, dependencies which are needed for boot and
+mounted in early userspace are not managed by the Shepherd, and so
+automatically filtered out for you.
+
+@item @code{priority} (default: @code{#f})
+Only supported by the Linux kernel.  Either @code{#f} to disable swap
+priority, or an integer between 0 and 32767.  The kernel will first use
+swap spaces of higher priority when paging, and use same priority spaces
+on a round-robin basis.  The kernel will use swap spaces without a set
+priority after prioritized spaces, and in the order that they appeared in
+(not round-robin).
+
+@item @code{discard?} (default: @code{#f})
+Only supported by the Linux kernel.  When true, the kernel will notify
+the disk controller of discarded pages, for example with the TRIM
+operation on Solid State Drives.
+
+@end table
+@end deftp
+
+Here are some examples:
+
+@lisp
+(swap-space (target (uuid "4dab5feb-d176-45de-b287-9b0a6e4c01cb")))
+@end lisp
+
+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.
+
+@lisp
+(swap-space
+  (target (file-system-label "swap"))
+  (dependencies (list lvm-device)))
+@end lisp
+
+Use the partition with label @code{swap}, which can be found after the
+@var{lvm-device} mapped device has been opened.  Again, the
+@command{swaplabel} command allows you to view and change the label of a
+Linux swap partition.
+
+@lisp
+(swap-space
+  (target "/btrfs/swapfile")
+  (dependencies (list btrfs-fs)))
+@end lisp
+
+Use the file @file{/btrfs/swapfile} as swap space, which is present on the
+@var{btrfs-fs} filesystem.
+
 @node User Accounts
 @section User Accounts
 
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index c928008c92..6df53844b1 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -1,6 +1,6 @@
 ;; This is an operating system configuration template
 ;; for a "desktop" setup with GNOME and Xfce where the
-;; root partition is encrypted with LUKS.
+;; root partition is encrypted with LUKS, and a swap file.
 
 (use-modules (gnu) (gnu system nss))
 (use-service-modules desktop xorg)
@@ -42,6 +42,11 @@
                          (type "vfat")))
                  %base-file-systems))
 
+  ;; Specify a swap file for the system, which resides on the
+  ;; root file system.
+  (swap-devices (list (swap-space
+                       (target "/swapfile"))))
+
   ;; Create user `bob' with `alice' as its initial password.
   (users (cons (user-account
                 (name "bob")
-- 
2.33.1

bug#51346: [PATCH 0/1 core-updates-frozen] Rework swap device to add dependencies and flags

[Ludovic Courtès]

Hi Josselin,

Josselin Poiret <dev@jpoiret.xyz> skribis:

> Thanks for the review!  Here is hopefully the last patchset, which
> addresses most of the issues.
>
> I decided not to merge the doc changes with the first commit as it
> also describes swap flags, but that's just a matter of taste I
> suppose.
>
> Moved the deprecation warning that I originally put in
> gnu/services/base.scm (swap-service) to a sanitizer of swap-devices in
> its own commit, although it only reports the location of the
> (operating-system) syntax use, not of the field itself (but that is
> what I also noticed for other deprecation warnings, alas).  I marked
> the field as delayed, otherwise I was getting a lot of warnings while
> testing rather than the only one I'm getting now.

I suppose this can be addressed with this newfangled
‘define-with-syntax-properties’, right?  :-)

> Fixed the swap-device dependency filtering to silently ignore
> old-style values rather than erroring out.
>
> Overall, I cleaned up all the rogue TABs I had inserted!
> (setq-default indent-tabs-mode nil) for our Emacs readers at home.
> This should not happen any more as I have set whitespace-mode to an
> aggressive red highlighting for TAB characters.

Nice.  Note that ‘.dir-locals.el’ is supposed to set that; not sure why
it didn’t work for you.

> And finally, I changed the examples at the end to simply be @lisp
> blocks, outside of a table.
>
> Josselin Poiret (5):
>   gnu: system: Rework swap space support, add dependencies.
>   gnu: system: Warn about swap-devices format change
>   gnu: system: Add swap flags.
>   gnu: system: Filter out boot dependencies from swap-space.
>   doc: Add new Swap Space section.

Applied on ‘master’, which I plan to merge into ‘core-updates-frozen’
shortly.

Thank you!

Ludo’.