Message ID | 20211027150913.6038-2-dev@jpoiret.xyz |
---|---|
State | Accepted |
Headers | show |
Series | Rework swap, add flags and dependencies. | expand |
Context | Check | Description |
---|---|---|
cbaines/comparison | success | View comparision |
cbaines/git branch | success | View Git branch |
cbaines/applying patch | success | View Laminar job |
cbaines/issue | success | View issue |
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’.
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’.
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(-)
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’.
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