From debbugs-submit-bounces@debbugs.gnu.org Wed Oct 27 11:09:43 2021 Received: (at 51346) by debbugs.gnu.org; 27 Oct 2021 15:09:43 +0000 Received: from localhost ([127.0.0.1]:50182 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mfkYg-0000Np-P4 for submit@debbugs.gnu.org; Wed, 27 Oct 2021 11:09:43 -0400 Received: from jpoiret.xyz ([206.189.101.64]:34654) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mfkYf-0000Nh-8R for 51346@debbugs.gnu.org; Wed, 27 Oct 2021 11:09:41 -0400 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 7DC55184BC9; Wed, 27 Oct 2021 15:09:40 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1635347380; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=d+fmujT6setCL9MnWntBntviV5dlhnM8zxeOYNC/OX8=; b=Jk9S4qjpfFsYNAnpPhZAvCVFmA19E9vzeM/wCHpQ+J4atY9RMkFdcJX8x9286leNSS1m40 67mykt4xCKpmozuMor218Hm6Bar95S/RInNX5DGmq9F0eUARAhBNKTcGX822/berHCmdAg 4KA6kg3EE6g2PvR4PdmCNCfS5kj6TljTo5cPMIXM+w3E4rCAu5oLtIcS7c1VoO6LWG1V+A wgQzFOGNBdnnVS8CiGcTb6cmOY/cCbc4uv5JDE5Gw3KOzOTDhMBRkuJZfA/EgkQegqaHXc ScgJWOTcCUTeQh0UeGXelLiyxjLEwHtRxaxNG0XH18GF8+dWc2E7ecqQBfUamA== From: Josselin Poiret To: Tobias Geerinckx-Rice Subject: [PATCH v2 1/4] gnu: system: Rework swap space support, add dependencies. Date: Wed, 27 Oct 2021 15:09:10 +0000 Message-Id: <20211027150913.6038-2-dev@jpoiret.xyz> In-Reply-To: <20211027150913.6038-1-dev@jpoiret.xyz> References: <87tuh6ifwe.fsf@nckx> <20211027150913.6038-1-dev@jpoiret.xyz> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz X-Spam-Score: 2.5 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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->shep [...] Content analysis details: (2.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: jpoiret.xyz (xyz)] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record 0.5 FROM_SUSPICIOUS_NTLD From abused NTLD X-Debbugs-Envelope-To: 51346 Cc: Josselin Poiret , 51346@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 1.5 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: * 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->shep [...] Content analysis details: (1.5 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 SPF_PASS SPF: sender matches SPF record 2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs [URI: jpoiret.xyz (xyz)] -0.0 SPF_HELO_PASS SPF: HELO matches SPF record 0.5 FROM_SUSPICIOUS_NTLD From abused NTLD -1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list manager * 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 (mapped-devices operating-system-mapped-devices ; list of (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 | (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 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