From unknown Tue Jun 17 20:21:28 2025 Content-Disposition: inline Content-Transfer-Encoding: quoted-printable MIME-Version: 1.0 X-Mailer: MIME-tools 5.509 (Entity 5.509) Content-Type: text/plain; charset=utf-8 From: bug#77106 <77106@debbugs.gnu.org> To: bug#77106 <77106@debbugs.gnu.org> Subject: Status: [PATCH 0/1] Add autofs-service-type Reply-To: bug#77106 <77106@debbugs.gnu.org> Date: Wed, 18 Jun 2025 03:21:28 +0000 retitle 77106 [PATCH 0/1] Add autofs-service-type reassign 77106 guix-patches submitter 77106 Ian Eure severity 77106 normal tag 77106 patch thanks From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 18 20:14:46 2025 Received: (at submit) by debbugs.gnu.org; 19 Mar 2025 00:14:46 +0000 Received: from localhost ([127.0.0.1]:43927 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tuh52-0005wj-N3 for submit@debbugs.gnu.org; Tue, 18 Mar 2025 20:14:46 -0400 Received: from lists.gnu.org ([2001:470:142::17]:53428) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tuh4z-0005v9-Ks for submit@debbugs.gnu.org; Tue, 18 Mar 2025 20:14:42 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tuh4p-00048O-FE for guix-patches@gnu.org; Tue, 18 Mar 2025 20:14:31 -0400 Received: from fhigh-a2-smtp.messagingengine.com ([103.168.172.153]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tuh4n-00051T-Gu for guix-patches@gnu.org; Tue, 18 Mar 2025 20:14:31 -0400 Received: from phl-compute-07.internal (phl-compute-07.phl.internal [10.202.2.47]) by mailfhigh.phl.internal (Postfix) with ESMTP id 9D93B114021D; Tue, 18 Mar 2025 20:14:26 -0400 (EDT) Received: from phl-mailfrontend-02 ([10.202.2.163]) by phl-compute-07.internal (MEProxy); Tue, 18 Mar 2025 20:14:26 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=retrospec.tv; h= cc:cc:content-transfer-encoding:content-type:content-type:date :date:from:from:in-reply-to:message-id:mime-version:reply-to :subject:subject:to:to; s=fm3; t=1742343266; x=1742429666; bh=dx vUwFWXfwb2AQn2TTUavFFUq1PxbRZIQZvFHnsrdzw=; b=Ybwadfez0Vf3m4H7op mRFr3JrhpCDiIgFLsewax1AIxuwB6SlyAu5sG+Jjae8lsyVzNOdnTOxa0o+UfUlW +rKCVb1toL5gmjAK6uB7vHVRnqdbRZRyFgibieQTFMlE1fJEFtzm9HLA0PStxyRJ MrEM8IGdfNdEoW9QY2HLaQ6hAxgz9eMusiDAXwM+ZsHDFa7TGkctGhey2BB5Fv7T ori9vM2lfUp1QZnCNRazZIqylr8Hby8LjxeyFvkkn8nA5aIkbYnZV8fkDD22TPQF obI1i4fTw9AU38vLnXZuz36Wr8Cenzw79LPq8LwWydethNhTsvwH+KPgi9I+QMw1 sAEQ== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-transfer-encoding :content-type:content-type:date:date:feedback-id:feedback-id :from:from:in-reply-to:message-id:mime-version:reply-to:subject :subject:to:to:x-me-proxy:x-me-sender:x-me-sender:x-sasl-enc; s= fm1; t=1742343266; x=1742429666; bh=dxvUwFWXfwb2AQn2TTUavFFUq1Px bRZIQZvFHnsrdzw=; b=GPKfukh8Wtoxj5sJrDIfct7CIgQyCRcqTi9WQIrD4DkM 3TLqQIghpxgEjg0v5p8cYrSWH/PvpNtJc66HlrXXQa8Zj8iLtBXqOu/5cCAj6dG9 VWDOwW/KTiNaBBtgqug53ISg3jR35atuEnKFoTf3H8mcVQE+rn7XnGlgyW0CZVLx Nad6Aws1WvVAk9BREEnT3CMgY7VqJ05wwY662bf8QuqyFHsqVaf/8vaS1OR2tUSv JOx63TW8uuX5gffiw/zGPnVE6bWogXdpxgmyoqX4yK3U0su4ezABz8wtcgyh9rL3 g0Socq134Sq0pjS4488aurXS2+/DHPEpv84g9VMqtg== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgeefvddrtddtgddugeefkeeiucetufdoteggodetrf dotffvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdggtfgfnhhsuhgsshgtrhhisggv pdfurfetoffkrfgpnffqhgenuceurghilhhouhhtmecufedttdenucenucfjughrpefhvf evufffkffogggtgfesthekredtredtjeenucfhrhhomhepkfgrnhcugfhurhgvuceoihgr nhesrhgvthhrohhsphgvtgdrthhvqeenucggtffrrghtthgvrhhnpefgueekffejudfgvd evteelteeitdeuuddufffhuefhiefhjeetuefhgfettedvteenucevlhhushhtvghrufhi iigvpedtnecurfgrrhgrmhepmhgrihhlfhhrohhmpehirghnsehrvghtrhhoshhpvggtrd htvhdpnhgspghrtghpthhtohepvddpmhhouggvpehsmhhtphhouhhtpdhrtghpthhtohep ghhuihigqdhprghttghhvghssehgnhhurdhorhhgpdhrtghpthhtohepihgrnhesrhgvth hrohhsphgvtgdrthhv X-ME-Proxy: Feedback-ID: id9014242:Fastmail Received: by mail.messagingengine.com (Postfix) with ESMTPA; Tue, 18 Mar 2025 20:14:25 -0400 (EDT) From: Ian Eure To: guix-patches@gnu.org Subject: [PATCH 0/1] Add autofs-service-type Date: Tue, 18 Mar 2025 17:14:20 -0700 Message-ID: <20250319001421.14954-1-ian@retrospec.tv> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=103.168.172.153; envelope-from=ian@retrospec.tv; helo=fhigh-a2-smtp.messagingengine.com X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H5=0.001, RCVD_IN_MSPIKE_WL=0.001, RCVD_IN_VALIDITY_CERTIFIED_BLOCKED=0.001, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: 0.7 (/) X-Debbugs-Envelope-To: submit Cc: Ian Eure 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: -0.3 (/) This is a draft of a system service to manage autofs, the lack of which has been an impediment to my daily-driver experience with Guix. It’s in working status, but incomplete (missing documentation) and may need other adjustments. I’m seeking feedback now, so I don’t waste time writing documentation for a moving target. What it does: - Lets you declaratively configure autofs in your operating-system. - Computes requirements based on the configuration, ex. if you have all local mounts, no requirements are added, but if you configure NFS mounts, it requires networking and rpc.statd services. - Supports direct mounts and indirect maps. - Flexibly supports any filesystem and mount options. - Creates mountpoints on service activation. - Most important of all, Works On My Machine. What it lacks: - Support for many autofs options, ex. verbose logging, "timeout for caching failed key lookups," a handful of others. I’ll add these in later versions of the patch. - Support for options per indirect map, ex no/browse, timeout, etc. I can add these if desired, but it’s somewhat annoying to do so. - Support for autofs maps other than the "file" type. Autofs supports many map formats, including esoteric things like maps stored in hesiod, nis, yp, ldap, etc. Most of these require fairly involved configuration, and are difficult to validate -- I don’t run hesiod or LDAP -- so I’ve omited them. The "file" type covers the majority of usecases. It’s possible to extend this patch to support them, should someone be motivated to do so. - Documentation. I want the code to be firmed up more before writing this. There are also some descriptions that need expanding. Areas which could use attention: - I’m not completely happy with how the config serializer works, for example, the `name' argument is mostly not used. I’m not sure if the model for this is a poor fit for my usecase or if I’m using it wrong. Feedback appreciated here. - I opted to use a loose configuration setup for mount options, where they’re specified as arbitrary lists. Options in the form `'(noatime (remount . ro) (wsize . 8192))' result in `noatime,remount=ro,wsize=8192'. While I think it might be nice to have fully explicit options, this would require very large configuration records, one per supported filesystem. I decided the cost-benefit wasn’t there. I considered reusing the `file-system' record from (gnu system file-systems), but it’s a poor match for this usecase, as it includes many irrelevant fields. - The name. I went with autofs-service-type to match the package, but "automount" is the name of the actual binary, and they’re used fairly interchangeably. It `provides' both autofs and automount. - Autofs itself doesn’t let you specify a configuration file and hardcodes the path to it (/etc/autofs.conf). Currently, the service doesn’t create one at all (it specifies the supported arguments on the command line), so autofs complains about that. I could add config file support if desired, but on a scale from One to Jazzed about it, I am Not Jazzed. Ian Eure (1): gnu: Add autofs-service-type. gnu/services/nfs.scm | 305 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 299 insertions(+), 6 deletions(-) -- 2.48.1 From debbugs-submit-bounces@debbugs.gnu.org Tue Mar 18 20:15:55 2025 Received: (at 77106) by debbugs.gnu.org; 19 Mar 2025 00:15:56 +0000 Received: from localhost ([127.0.0.1]:43941 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tuh67-0006CI-F9 for submit@debbugs.gnu.org; Tue, 18 Mar 2025 20:15:55 -0400 Received: from fout-a8-smtp.messagingengine.com ([103.168.172.151]:60273) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tuh62-0006Ag-6H for 77106@debbugs.gnu.org; Tue, 18 Mar 2025 20:15:49 -0400 Received: from phl-compute-07.internal (phl-compute-07.phl.internal [10.202.2.47]) by mailfout.phl.internal (Postfix) with ESMTP id E3DE013833D7; Tue, 18 Mar 2025 20:15:40 -0400 (EDT) Received: from phl-mailfrontend-02 ([10.202.2.163]) by phl-compute-07.internal (MEProxy); Tue, 18 Mar 2025 20:15:40 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=retrospec.tv; h= cc:cc:content-transfer-encoding:content-type:content-type:date :date:from:from:in-reply-to:message-id:mime-version:reply-to :subject:subject:to:to; s=fm3; t=1742343340; x=1742429740; bh=iv Q/KAyBQUEOMfURrA18XrL8fY1xYwtm3ds/9scBOig=; b=ZvKLG6vNBTuF0gFzBX fD9P2JpB/hnmTdkQyjmTiU8sSXeK5+c39lIeV3ToyrpF/yP+MIPc7JuM286xKHvZ yW+1k54u3Rq/wXMIh6agnrl1oPRN/LeJGun2DqJ08txTSQO/sslDayQHHEgEtVUC 4PR8X8NRLhCnPLBiRcO7l41d5abDHAkRs6rrvuMi+Zflk8sVJnjHAmEu1OqdIUTq 9HjehqMgb6B4qHAfPIjMkZtkY958KlzlraPdTVA+4TLIOf1SSU/BqSqr5OM+yXwR AmtcItvqaQUZW57hvItOYZNIEHq1596L/duBhWw2XZbmVMMAQb1/xJkL8y9B7llQ LVww== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-transfer-encoding :content-type:content-type:date:date:feedback-id:feedback-id :from:from:in-reply-to:message-id:mime-version:reply-to:subject :subject:to:to:x-me-proxy:x-me-sender:x-me-sender:x-sasl-enc; s= fm1; t=1742343340; x=1742429740; bh=ivQ/KAyBQUEOMfURrA18XrL8fY1x Ywtm3ds/9scBOig=; b=UfKb0cn57QOdQpPJFTq1WqJWJRvZPy0rx1vBiLVozcqh ku+UbY6O4yszdXj+M4ycRMcFf8RqkMlcbTHcZuiGmQtM4T47EymBc3gc9xkQgqv5 AAQTGGugiM5Fte61pDdF82QHZSlpWP7m3nqThiZFFKSC7dgMeD0iUVNTEPkiBupe TM+Kl7OtCzAJ4JlaBy9lU032u5pSQYgkcBF5tMRZryv1R6oTPm5LZwJgQ5UX/mat 0YUn6d3lvXbwMm19U6h7qDGYJW1g0eag8Flb7Dxoe28sPnyOUmOIyHMCYye4r3M7 RKjSKygHEptd7B04aDn2eY/sqm47GxVtG23Ua+yJnw== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgeefvddrtddtgddugeefkeeiucetufdoteggodetrf dotffvucfrrhhofhhilhgvmecuhfgrshhtofgrihhlpdggtfgfnhhsuhgsshgtrhhisggv pdfurfetoffkrfgpnffqhgenuceurghilhhouhhtmecufedttdenucenucfjughrpefhvf evufffkffogggtgfesthekredtredtjeenucfhrhhomhepkfgrnhcugfhurhgvuceoihgr nhesrhgvthhrohhsphgvtgdrthhvqeenucggtffrrghtthgvrhhnpeejuefghefgffefte ehvddtuddutefhvddtfeduhfdugfdvvdeulefgfefhhefhheenucffohhmrghinhepghhn uhdrohhrghenucevlhhushhtvghrufhiiigvpedtnecurfgrrhgrmhepmhgrihhlfhhroh hmpehirghnsehrvghtrhhoshhpvggtrdhtvhdpnhgspghrtghpthhtohepvddpmhhouggv pehsmhhtphhouhhtpdhrtghpthhtohepjeejuddtieesuggvsggsuhhgshdrghhnuhdroh hrghdprhgtphhtthhopehirghnsehrvghtrhhoshhpvggtrdhtvh X-ME-Proxy: Feedback-ID: id9014242:Fastmail Received: by mail.messagingengine.com (Postfix) with ESMTPA; Tue, 18 Mar 2025 20:15:40 -0400 (EDT) From: Ian Eure To: 77106@debbugs.gnu.org Subject: [PATCH 1/1] gnu: Add autofs-service-type. Date: Tue, 18 Mar 2025 17:15:32 -0700 Message-ID: <20250319001533.14995-1-ian@retrospec.tv> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 77106 Cc: Ian Eure 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.7 (-) * gnu/services/nfs.scm (autofs-service-type): New variable. (): New record. (): New record. (): New record. Change-Id: I4ed1862772001470d1214c3061a306440b0d775b --- gnu/services/nfs.scm | 305 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 299 insertions(+), 6 deletions(-) diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm index f5a1c6a44e..2321e4d056 100644 --- a/gnu/services/nfs.scm +++ b/gnu/services/nfs.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016 John Darrington ;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus ;;; Copyright © 2020, 2021 Maxim Cournoyer +;;; Copyright © 2023-2025 Ian Eure ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,16 +20,21 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services nfs) - #:use-module (gnu) - #:use-module (gnu services shepherd) - #:use-module (gnu packages onc-rpc) + #:use-module (gnu build file-systems) + #:use-module (gnu packages file-systems) #:use-module (gnu packages linux) #:use-module (gnu packages nfs) - #:use-module (guix) + #:use-module (gnu packages onc-rpc) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu) + #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix records) + #:use-module (guix) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:use-module (gnu build file-systems) #:export (rpcbind-service-type rpcbind-configuration rpcbind-configuration? @@ -47,7 +53,17 @@ (define-module (gnu services nfs) nfs-service-type nfs-configuration - nfs-configuration?)) + nfs-configuration? + + autofs-service-type + autofs-configuration + autofs-configuration? + + autofs-indirect-map + autofs-indirect-map? + + autofs-map-entry + autofs-map-entry?)) (define default-pipefs-directory "/var/lib/nfs/rpc_pipefs") @@ -451,3 +467,280 @@ (define nfs-service-type (rpcbind (nfs-configuration-rpcbind config))))))) (description "Run all NFS daemons and refresh the list of exported file systems."))) + + ;; Autofs + +(define %autofs-pid-file "/var/run/autofs.pid") + +(define (serialize-string _ x) x) + +(define (serialize-option-flag _ value) + (format #f "~a" value)) + +(define (option-flag? x) + "Is @var{x} a mount option flag? +Option flags are value like @var{ro}, @var{noatime}, @var{nosuid}, etc." + (or (string? x) + (symbol? x))) + +(define (option-value? x) + (or (option-flag? x) + (integer? x))) + +(define (option-pair? x) + "Is @var{x} an option pair? +Option pairs are cons cells of (option-flag . option-value), used for +mount options like @{var errors=remount-ro}, @var{timeo=600}, etc." + (and (pair? x) + (not (list? x)) + (option-flag? (car x)) + (option-value? (cdr x)))) + +(define (serialize-option-pair name value) + (string-append (serialize-option-flag name (car value)) + "=" + (serialize-option-flag name (cdr value)))) + +(define (file-system-option? x) + (or (option-flag? x) + (option-pair? x))) + +(define (serialize-file-system-option name x) + (cond + ((option-flag? x) (serialize-option-flag name x)) + ((option-pair? x) (serialize-option-pair name x)))) + +(define (file-system-options? x) + (list-of file-system-option?)) + +(define (serialize-file-system-options name value) + (string-join (map (cut serialize-file-system-option name <>) value) ",")) + +(define-configuration autofs-map-entry + (type (string "auto") + "The type of the filesystem.") + (device string + "Device or remote host to mount. May contain special +character @code{&}, which can be referenced in the @var{mount-point} +field.") + (mount-point string + "Directory to mount this device on. + +Map entries come in two flavors: direct and indirect. Direct entries +map a single device to a single mountpoint, while indirect entries can +map multiple devices to multiple mountpoints. + +A direct entry has a @var{mount-point} beginning with @code{/}, representing +the absolute path of the directory to mount the device on. For example: + + (autofs-map-entry + (type \"ext4\") + (device \"/dev/sdb1\") + (mount-point \"/mnt/external-disk\")) + +An indirect entry has a @var{mount-point} not beginning with @code{/}, +representing the subdirectory within the parent indirect map for this +entry. Indirect maps may also use the special character @code{*}, +which will be replaced with the value of special character @code{&} in +the @var{device} field of this entry. For example: + + (autofs-indirect-map + (mount-point \"/devices\") + (entries + (list + ;; Automount any block device r/o by ID. + (autofs-map-entry + (type \"auto\") + (mount-point \"ro/uuid/*\") + (device \"/dev/disk/by-id/&\") + (options '(ro))) + ;; Automount any block device by UUID. + (autofs-map-entry + (type \"auto\") + (mount-point \"rw/uuid/*\") + (device \"/dev/disk/by-uuid/&\"))))) +") + (options (file-system-options '()) + "List of mount options. + +Some options are simple flags, such as ro, noexec, nosuid, etc. These +may be expressed as strings or symbols. + +Other options also accept a value. These are expressed as pairs of +@code{(option . value)}. @code{option} may be a string or symbol, as +with flags. @code{value} may be a string, symbol, or number. + +Example: @code{(ro (errors . remount-ro) noexec)}")) + +(define (serialize-autofs-map-entry _ value) + (let ((all-options + (serialize-file-system-options + #f + `((fstype . ,(autofs-map-entry-type value)) + ,@(autofs-map-entry-options value))))) + (string-join (list (autofs-map-entry-mount-point value) + (string-append "-" all-options) + (serialize-string #f (autofs-map-entry-device value))) + " "))) + +(define autofs-map-entries? (list-of autofs-map-entry?)) + +(define (serialize-autofs-map-entries name value) + (string-join (map (cut serialize-autofs-map-entry name <>) value) + "\n")) + +(define-configuration autofs-indirect-map + (mount-point string "Where to mount the indirect map.") + (entries (autofs-map-entries '()) "Entries in this map.")) + +(define (serialize-autofs-indirect-map name value) + (serialize-autofs-map-entries name (autofs-indirect-map-entries value))) + +(define (autofs-direct-mount-point? mount-point) + (string= "/" (substring mount-point 0 1))) + +(define (autofs-direct-map? x) + (and (autofs-map-entry? x) + (autofs-direct-mount-point? (autofs-map-entry-mount-point x)))) + +(define (autofs-mount-map? x) + (or (autofs-direct-map? x) + (autofs-indirect-map? x))) + +(define (autofs-mount-maps? x) + (list-of autofs-mount-map?)) + +(define (serialize-integer name value) + (format #f "~a" value)) + +(define-configuration autofs-configuration + (autofs (package autofs) "The autofs package to use.") + (timeout (integer 300) + "Mount timeout, in seconds." + (serializer empty-serializer)) + (mounts (autofs-mount-maps '()) + "Mount maps to manage. + +This is a list of either direct map entries or indirect mount maps." + (serializer empty-serializer))) + +(define (indirect-map->file-name indirect-map) + (string-append + (string-replace-substring + (substring (autofs-indirect-map-mount-point indirect-map) 1) + "/" "-") ".map")) + +(define (config->maps config) + (let* ((mounts (autofs-configuration-mounts config)) + (direct-maps + (map serialize-autofs-map-entry + (filter autofs-direct-map? mounts))) + (indirect-maps + (map + (lambda (indirect-map) + (list (indirect-map->file-name indirect-map) + (autofs-indirect-map-mount-point indirect-map) + (serialize-autofs-indirect-map #f indirect-map))) + (filter autofs-indirect-map? mounts)))) + (computed-file + "autofs-maps" + (with-imported-modules + (source-module-closure '((guix build utils) (ice-9 match))) + #~(begin + (use-modules (guix build utils) (ice-9 match)) + + (mkdir-p #$output) + + (call-with-output-file (string-append #$output "/auto.master") + (lambda (master-map) + ;; Write the direct entries to the master map. + (for-each (lambda (entry) (display entry master-map)) + '#$direct-maps) + (for-each + (match-lambda + ((file-name mount-point content) + ;; Write the indirect map. + (call-with-output-file + (string-append #$output "/" file-name) + (lambda (indirect-map) (display content indirect-map))) + ;; Reference it in the master map. + (format master-map "~a ~a/~a" + mount-point #$output file-name))) + '#$indirect-maps)))))))) + +(define (autofs-activation config) + (let ((mount-points + (map + autofs-indirect-map-mount-point + (filter + autofs-indirect-map? + (autofs-configuration-mounts config))))) + #~(begin + (use-modules (guix build utils)) + (mkdir-p "/var/lib/nfs/sm") + (for-each mkdir-p '#$mount-points)))) + +(define (autofs-configuration->raw-entries config) + (fold + (lambda (mount acc) + (cond + ((autofs-direct-map? mount) + (cons mount acc)) + ((autofs-indirect-map? mount) + (append (autofs-indirect-map-entries mount) acc)))) + '() + (autofs-configuration-mounts config))) + +(define (autofs-configuration->requirements config) + "Compute Shepherd service requirements for @var{config}. + +If @var{config} contains NFS mounts, adds rpc.statd and networking to +the service requirements. + +If @var{config} contains SMB mounts, adds networking to the service +requirements. +" + (delete-duplicates + (fold + (lambda (fs-type acc) + (cond + ((string= "nfs" fs-type) + (append acc '(networking rpc.statd))) + ((string= "smb" fs-type) + (cons 'networking acc)))) + '() + (map autofs-map-entry-type (autofs-configuration->raw-entries config))))) + +(define (autofs-shepherd-service config) + (match-record config (autofs timeout) + (begin + (define autofs-command + #~(list + #$(file-append autofs "/sbin/automount") + "-f" + "-t" (number->string #$timeout) + "-p" #$%autofs-pid-file + #$(file-append (config->maps config) "/auto.master"))) + + (list + (shepherd-service + (provision '(autofs automount)) + (documentation "Run the autofs daemon.") + (requirement (autofs-configuration->requirements config)) + (start + #~(make-forkexec-constructor + #$autofs-command + #:pid-file #$%autofs-pid-file)) + (stop #~(make-kill-destructor))))))) + +(define-public autofs-service-type + (service-type + (name 'autofs) + (description "Run autofs") + (extensions + (list + (service-extension shepherd-root-service-type + autofs-shepherd-service) + (service-extension activation-service-type + autofs-activation))) + (default-value (autofs-configuration)))) -- 2.48.1