From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id 4HhSE+PCkmErWwEAgWs5BA (envelope-from ) for ; Mon, 15 Nov 2021 21:28:19 +0100 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id mB0TD+PCkmF7ewAA1q6Kng (envelope-from ) for ; Mon, 15 Nov 2021 20:28:19 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 0531D14891 for ; Mon, 15 Nov 2021 21:28:18 +0100 (CET) Received: from localhost ([::1]:58052 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mmiaP-0007vE-89 for larch@yhetil.org; Mon, 15 Nov 2021 15:28:17 -0500 Received: from eggs.gnu.org ([209.51.188.92]:56560) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mmiaA-0007f5-S7 for guix-patches@gnu.org; Mon, 15 Nov 2021 15:28:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:44741) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mmiaA-00036w-KD for guix-patches@gnu.org; Mon, 15 Nov 2021 15:28:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1mmiaA-0008Vl-Gq for guix-patches@gnu.org; Mon, 15 Nov 2021 15:28:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#51346] [PATCH v3 1/5] gnu: system: Rework swap space support, add dependencies. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 15 Nov 2021 20:28: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: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: Josselin Poiret , Tobias Geerinckx-Rice , 51346@debbugs.gnu.org Received: via spool by 51346-submit@debbugs.gnu.org id=B51346.163700803732597 (code B ref 51346); Mon, 15 Nov 2021 20:28:02 +0000 Received: (at 51346) by debbugs.gnu.org; 15 Nov 2021 20:27:17 +0000 Received: from localhost ([127.0.0.1]:56270 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mmiZR-0008Tb-26 for submit@debbugs.gnu.org; Mon, 15 Nov 2021 15:27:17 -0500 Received: from jpoiret.xyz ([206.189.101.64]:34722) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mmiZP-0008TD-GP for 51346@debbugs.gnu.org; Mon, 15 Nov 2021 15:27:16 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 3A2DF184F5F; Mon, 15 Nov 2021 20:27:14 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1637008034; 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=IzP42peC19fRTdv8GnXtbrzlgER2BZhEDkMrqGPFnTI=; b=EvLgiQZf8wleGPDLhTmqhclb2j2O4BkS2AqVQfff4miC7SOo/a2XbxwL9WSFa62wPsPDPo rll6ZFYwp8+6hfmYumvi7bXKSGe4HUoaCI4spHLlo0P1T9cu58pa2QMVTMBVbtvOLS5sct 9D8+7TlFzGGpwVf2rybeB9CnYzuIqtaDKSaXy5sU9DwEf1NQyeRasU4/CwU05DmRqYBZq5 bZjmrCBcjpofcEE8bJxetX8qW9z9BhbfDSHHexMturdjbG/WTa8/TsgZcxdI4eNIPlB6sa tluxOiEaj3jzKOPWA6WFJLX0YiTA5p2jZ7wuaoL3VC53tiSQVY3RO1K3NWLSXQ== Date: Mon, 15 Nov 2021 20:26:27 +0000 Message-Id: <20211115202631.6032-2-dev@jpoiret.xyz> In-Reply-To: <20211115202631.6032-1-dev@jpoiret.xyz> References: <87y25p65on.fsf_-_@gnu.org> <20211115202631.6032-1-dev@jpoiret.xyz> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spamd-Bar: / 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches From: Josselin Poiret via Guix-patches via X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1637008098; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=IzP42peC19fRTdv8GnXtbrzlgER2BZhEDkMrqGPFnTI=; b=MyFPAtZu8U0BswXYHp3vaopRo77zw6MV0tmDXvG/vLKUtfJPdGvkHyoKSjMhG1k+M88rPW NwsFQLRpdYha1O6p4hV6Z1c+WZRnsZwxtyRqOMhAr5feZvtYbPYBVnlzSIgyS1Hz9lVFKl oC8ebA83Xh7IE/HtEOiikwDz9NNSLkm1QpiHrVSZaftfgVjtQ527R/OHGUwQc4RzXKmNqi vJvqtRllD+UR9SzuFXff6gkbUt822tjfXMrCehV1P5rm5BM70ggRsCcFHxQmRb8v3INu2j nkA0bPMjGYoEs52z5HuboXknSvsGresL1kjVC61kC7ONX8KwRXpUd3ZFM35smQ== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1637008098; a=rsa-sha256; cv=none; b=Cj7pzegNzLtAUpKDlawUFRJ2KfmSjJlpxTz0w8uXTJwM8k4Z5/EA/Q5ajgc8tbUET8TNBn mSknCRRQcDeOEvQKx5Ns4C9Ks7LvEifBp5WPJRZXEbNKmdBM9anFaR+Jave4rOCrTnH1+O p88AShHxpY1OdNmD/O0+QZifsEMjo6HE2WmrOEGpLzKnk1FKozCjIhPyDBSBMsYkn0Kloe bKNQuLGEgF8ztFnfMyRtbq8PM1Wo/Ub41oLS2XcSyVtD/x9IOtqQmbir35/CQm51vFkqcm 4BGHC6zeGJaa50sVD5yl/fmDP2dRxvQB+tbj2z5RL9Rk2gEQol/7vwXLHecbdQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=EvLgiQZf; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: 0.66 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=EvLgiQZf; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 0531D14891 X-Spam-Score: 0.66 X-Migadu-Scanner: scn1.migadu.com X-TUID: xdbJzFpkgk4i * 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 (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 - (default '())) + (swap-devices operating-system-swap-devices ; list of string | + (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 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