From patchwork Wed Oct 27 15:09:10 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 34116 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0B1CD27BBE3; Wed, 27 Oct 2021 16:49:21 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,T_DKIM_INVALID, URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7D23927BBE1 for ; Wed, 27 Oct 2021 16:49:20 +0100 (BST) Received: from localhost ([::1]:39290 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mflB1-0003wS-E8 for patchwork@mira.cbaines.net; Wed, 27 Oct 2021 11:49:19 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:57880) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mfkZ0-0004Pl-R9 for guix-patches@gnu.org; Wed, 27 Oct 2021 11:10:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:38649) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mfkZ0-000784-Hd for guix-patches@gnu.org; Wed, 27 Oct 2021 11:10:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mfkZ0-0000PG-DG for guix-patches@gnu.org; Wed, 27 Oct 2021 11:10:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#51346] [PATCH v2 1/4] gnu: system: Rework swap space support, add dependencies. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 27 Oct 2021 15:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 51346 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Tobias Geerinckx-Rice Cc: Josselin Poiret , 51346@debbugs.gnu.org Received: via spool by 51346-submit@debbugs.gnu.org id=B51346.16353473831482 (code B ref 51346); Wed, 27 Oct 2021 15:10:02 +0000 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== 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 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * 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