From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id CA2LCgJ1eWHnPgAAgWs5BA (envelope-from ) for ; Wed, 27 Oct 2021 17:49:22 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id kL9KBgJ1eWH7JAAA1q6Kng (envelope-from ) for ; Wed, 27 Oct 2021 15:49:22 +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 AD9BF10B4 for ; Wed, 27 Oct 2021 17:49:21 +0200 (CEST) Received: from localhost ([::1]:39290 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mflB2-0003wS-Oc for larch@yhetil.org; Wed, 27 Oct 2021 11:49:20 -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 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=1635349762; 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=d+fmujT6setCL9MnWntBntviV5dlhnM8zxeOYNC/OX8=; b=GKuZMjeooASeA9W1gJAAm8aGZtf01UN+WlqTjpnJCWsYxK69PtRzdHor1XvW870uSQszQQ RtnHgqkLTh7gvV602MeXv0ujxeM2s7z82pA1/Ho2PdvxbxdKbFDNbdclTypC8K7/AfXkxg AXw0qepkU07qHOAhQhIiky6Q7dV+VnC/BXYWXPVP5/AcqgGI98mDzBr/+jXi77PfDvnhMX 4JwlSx36JI96NeRLOpSPofLiy7UUIy/5GG4tmozZW1HBbKji2gC7T8kgEmtv6GdJU0Lg8t zSjKgyyM1P+cxQk9C/ErPE7p4+k1tP0fd/5xaS8z8w7kjj93q3IsgXhaXzqkbA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1635349762; a=rsa-sha256; cv=none; b=qmNWQplaUp7CaLVtsj+C/yBo5UofNrpedaIhxJqbJmhVpCxH0Rgx6L6AtRdVhZj2dDk1tO 8O9LhI1MGE/zuzqZjaDrF0XIrMelKK+7y3w0L59LUic6A+Kd2dxEG2G5nqeA5yF2hwVOwN 66fXcm4XBk4XP8ggWpWNkem/du+aKq7Wwz7XRuaFeWdJcmIALkOmERzd4myKytJMHLQz8g iOM5VOwikH9RuV3Bqgp07NSRN0B+06oNS+xNhuTlOWiC2UKN9rHvoi7djTN/Mk+EcKibeT vbSV3cM7GOD9yAQ7Lo+E61fEccAMUBHc1z7C/hnuhhg0ZhQxPWPup1mK81X41A== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=Jk9S4qjp; 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-Spam-Score: 2.57 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=Jk9S4qjp; 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: AD9BF10B4 X-Spam-Score: 2.57 X-Migadu-Scanner: scn0.migadu.com X-TUID: XgnNsm6jRDtO * 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