From fa4aba28a0877338b46728c21768d894463163a9 Mon Sep 17 00:00:00 2001 From: Ian Eure Date: Tue, 18 Mar 2025 16:29:23 -0700 Subject: [PATCH] gnu: Add autofs-service-type. * gnu/services/nfs.scm (autofs-service-type): New variable. (): New record. (): New record. (): New record. Change-Id: I4ed1862772001470d1214c3061a306440b0d775b --- doc/guix.texi | 245 +++++++++++++++++++++ gnu/services/nfs.scm | 511 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 749 insertions(+), 7 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 272a1579ec..8b569c7fbc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -37762,6 +37762,251 @@ The verbosity level of the daemon. @end table @end deftp + + +@subsubheading Autofs Service +@cindex autofs +@cindex automount + +The autofs service automatically mounts and unmounts filesystems. It +can mount both network and local storage, but is most often used to +manage NFS mounts. + +A typical configuration might look like: + +@lisp +(operating-system + (services + (append + (list + (service nfs-service-type (nfs-configuration)) + (service autofs-service-type + (autofs-configuration + (mounts + (list + (autofs-indirect-map + (mount-point "/net/home") + (entries + (list + ;; Accessing /net/home/foo will mount + ;; big.network.server:/home/foo. + (autofs-map-entry + (type "nfs") + (device "big.network.server:/home/&") + (mount-point "*")))))))))) + %base-services))) +@end lisp + +@deftp {Data Type} autofs-indirect-map +Available @code{autofs-indirect-map} fields are: + +@table @asis +@item @code{mount-point} (type: string) +Where to mount the indirect map. + +@item @code{entries} (default: @code{()}) (type: autofs-map-entries) +Entries in this map. + +@end table +@end deftp + +@deftp {Data Type} autofs-map-entry +Available @code{autofs-map-entry} fields are: + +@table @asis +@item @code{type} (default: @code{"auto"}) (type: string) +The type of the filesystem. + +@item @code{device} (type: string) +Device or remote host to mount. May contain special character @code{&}, +which can be referenced in the @var{mount-point} field. + +@item @code{mount-point} (type: 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: + +@lisp +(autofs-map-entry + (type "ext4") + (device "/dev/sdb1") + (mount-point "/mnt/external-disk")) +@end lisp + +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: + +@lisp +(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/&"))))) +@end lisp + +@item @code{options} (default: @code{()}) (type: 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)} + +@end table +@end deftp + +@deftp {Data Type} autofs-configuration +Available @code{autofs-configuration} fields are: + +@table @asis +@item @code{autofs} (default: @code{autofs}) (type: package) +The autofs package to use. + +@item @code{mounts} (default: @code{()}) (type: autofs-mount-maps) +Mount maps to manage. This is a list of either direct map entries or +indirect mount maps. + +@item @code{timeout} (default: @code{300}) (type: conf-integer) +Sets the default mount timeout in seconds. + +@item @code{master-wait} (default: @code{10}) (type: conf-integer) +Sets the default maximum number of retries (actual iterations is half +this, each is delayed by 2 seconds before retrying) waiting for the +master map to become available if it cannot be read at program start. +This can be longer if the map source itself waits for availability (such +as sss). + +@item @code{negative-timeout} (default: @code{60}) (type: conf-integer) +Set the default timeout for caching failed key lookups. + +@item @code{mount-verbose?} (default: @code{#f}) (type: conf-boolean) +Use the verbose flag when spawning mount(8), and log some process info +about the requestor and its parent. + +@item @code{mount-wait} (default: @code{-1}) (type: conf-integer) +Set the default time to wait for a response from a spawned mount(8) +before sending it a SIGTERM. Note that we still need to wait for the +RPC layer to timeout before the sub-process exits so this isn't ideal +but it is the best we can do. The default is to wait until mount(8) +returns without intervention. + +@item @code{umount-wait} (default: @code{12}) (type: conf-integer) +Set the default time to wait for a response from a spawned umount(8) +before sending it a SIGTERM. Note that we still need to wait for the +RPC layer to timeout before the sub-process exits so this isn't ideal +but it is the best we can do. + +@item @code{browse-mode?} (default: @code{#t}) (type: conf-boolean) +Should maps be browsable by default? + +@item @code{mount-nfs-default-protocol} (default: @code{3}) (type: conf-integer) +Set the default protocol that mount.nfs(8) uses when performing a mount. +Autofs needs to know the default NFS protocol that mount.nfs(8) uses so +it can do special case handling for its availability probe for different +NFS protocols. Since we can't identify this default automatically we +need to set it in the autofs configuration. + +@item @code{append-options?} (default: @code{#t}) (type: conf-boolean) +When #t, global options are appended to map entry options. When #f, map +entry options replace the global options. + +@item @code{logging} (type: conf-log-level) +Default log level. May be #:none, #:verbose, or #:debug. + +@item @code{force-standard-program-map-env?} (default: @code{#f}) (type: conf-boolean) +Override the use of a prefix with standard environment variables when a +program map is executed. Since program maps are run as the privileged +user setting these standard environment variables opens automount(8) to +potential user privilege escalation when the program map is written in a +language that can load components from, for example, a user home +directory. + +@item @code{map-hash-table-size} (default: @code{1024}) (type: conf-integer) +This configuration option may be used to change the number of hash table +slots. This configuration option affects the overhead of searching the +map entry cache for map entries when there are a large number of +entries. It affects the number of entries that must be looked at to +locate a map entry in the map entry cache. For example, the default of +1024 and a direct map with 8000 entries would result in each slot +containing an average of 8 entries, which should be acceptable. However, +if excessive CPU usage is observed during automount lookups increasing +this option can reduce the CPU overhead considerably because it reduces +the length of the search chains. Note that the number of entries in a +map doesn't necessarily relate to the number of entries used in the map +entry cache. There are two distinct cases where the map hash table can +make a significant difference, direct maps and indirect maps that use +the "browse" option. For indirect maps that do not use the "browse" +option entries are added to the map entry cache at lookup so the number +of active cache entries, in this case, is usually much less than the +number of entries in the map. In this last case it would be unusual for +the map entry cache to grow large enough to warrant increasing the +default before an event that cleans stale entries, a map re-read for +example. + +@item @code{use-hostname-for-mounts?} (default: @code{#f}) (type: conf-boolean) +NFS mounts where the host name resolves to more than one IP address are +probed for availability and to establish the order in which mounts to +them should be tried. To ensure that mount attempts are made only to +hosts that are responding and are tried in the order of hosts with the +quickest response the IP address of the host needs to be used for the +mount. If it is necessary to use the hostname given in the map entry +for the mount regardless, then set this option to #t. Be aware that if +this is done there is no defense against the host name resolving to one +that isn't responding and while the number of attempts at a successful +mount will correspond to the number of addresses the host name resolves +to the order will also not correspond to fastest responding hosts. + +@item @code{disable-not-found-message?} (default: @code{#f}) (type: conf-boolean) +The original request to add this log message needed it to be +unconditional. That produces, IMHO, unnecessary noise in the log so a +configuration option has been added to provide the ability to turn it +off. + +@item @code{use-ignore-mount-option?} (default: @code{#f}) (type: conf-boolean) +An option to enable the use of autofs pseudo option "disable". This +option is used as a hint to user space that the mount entry should be +omitted from mount table listings. The default is #f to avoid +unexpected changes in behaviour and so is an opt-in setting. + +@item @code{sss-master-map-wait} (default: @code{0}) (type: conf-integer) +Set the time to wait and retry if sssd is unable to read the master map +at program start. Default is 0 (don't wait) or 10 if sss supports +returning EHSTDOWN when the provider isn't available. If the sss +library upports returning EHOSTDOWN when the provider is down then this +value is how long to wait between re‐ tries reading the master map. When +reading dependent maps or looking up a map key this value is multiplied +by the number of retries that would be used when reading the master map. + +@item @code{use-mount-request-log-id?} (default: @code{#f}) (type: conf-boolean) +Set whether to use a mount request log id so that log entries for +specific mount requests can be easily identified in logs that have +multiple concurrent requests. + +@end table + +@end deftp + + +@c %end of fragment + + + @node Samba Services, Continuous Integration, Network File System, Services @subsection Samba Services diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm index a5e35db6a3..03ef4e6f9a 100644 --- a/gnu/services/nfs.scm +++ b/gnu/services/nfs.scm @@ -1,7 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016 John Darrington +;;; Copyright © 2016, 2025 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,22 @@ ;;; 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 (srfi srfi-171) #:use-module (ice-9 match) - #:use-module (gnu build file-systems) #:export (rpcbind-service-type rpcbind-configuration rpcbind-configuration? @@ -47,8 +54,17 @@ 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,484 @@ via NFSv4.")))) (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 (value->string _ value) + (object->string value display)) + +(define (option-flag? value) + "Is @var{value} a mount option flag? +Option flags are value like @var{ro}, @var{noatime}, @var{nosuid}, etc." + (or (string? value) + (symbol? value))) + +(define (option-value? value) + (or (option-flag? value) + (integer? value))) + +(define (option-pair? value) + "Is @var{value} 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." + (match value + (((? option-flag? _) . (? option-value? _)) #t) + (_ #f))) + +(define (serialize-option-pair name value) + (match value + ((option-flag . option-value) + (string-append (value->string name option-flag) + "=" + (value->string name option-value))))) + +(define (file-system-option? value) + (or (option-flag? value) + (option-pair? value))) + +(define (serialize-file-system-option name value) + (cond + ((option-flag? value) (value->string name value)) + ((option-pair? value) (serialize-option-pair name value)))) + +(define (file-system-options? value) + (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." + (serializer value->string)) + (device string + "Device or remote host to mount. May contain special +character @code{&}, which can be referenced in the @var{mount-point} +field." + (serializer value->string)) + (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/&\")))))" + (serializer value->string)) + (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) + (value->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" + 'suffix)) + +(define-configuration autofs-indirect-map + (mount-point string "Where to mount the indirect map." + (serializer value->string)) + (entries (autofs-map-entries '()) "Entries in this map.")) + +(define (autofs-serialize-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? value) + (and (autofs-map-entry? value) + (autofs-direct-mount-point? (autofs-map-entry-mount-point value)))) + +(define (mount-map? value) + (or (autofs-direct-map? value) + (autofs-indirect-map? value))) + +(define (mount-maps? value) + (list-of mount-map?)) + +(define (scheme->autofs name-sym) + (string-replace-substring + (string-replace-substring (symbol->string name-sym) "-" "_") + "?" "")) + +(define (autofs-serialize-integer name value) + (format #f "~a = ~a" (scheme->autofs name) value)) + +(define (autofs-serialize-boolean name value) + (format #f "~a = ~a" (scheme->autofs name) (if value "yes" "no"))) + +(define (log-level? value) + (and (keyword? value) + (member value '(#:none #:verbose #:debug)))) + +(define (autofs-serialize-log-level name value) + (format #f "~a = ~a" (scheme->autofs name) + (symbol->string (keyword->symbol value)))) + +(define-configuration autofs-configuration + (autofs + (package autofs) + "The autofs package to use." + (serializer empty-serializer)) + + (mounts + (mount-maps '()) + "Mount maps to manage. + +This is a list of either direct map entries or indirect mount maps." + (serializer empty-serializer)) + + (timeout + (integer 300) + "Sets the default mount timeout in seconds.") + + (master-wait + (integer 10) + "Sets the default maximum number of retries (actual iterations is half +this, each is delayed by 2 seconds before retrying) waiting for the master map +to become available if it cannot be read at program start. This can be longer +if the map source itself waits for availability (such as sss).") + + (negative-timeout + (integer 60) + "Set the default timeout for caching failed key lookups.") + + (mount-verbose? + (boolean #f) + "Use the verbose flag when spawning mount(8), and log some process info +about the requestor and its parent.") + + (mount-wait + (integer -1) + "Set the default time to wait for a response from a spawned mount(8) before +sending it a SIGTERM. Note that we still need to wait for the RPC layer to +timeout before the sub-process exits so this isn't ideal but it is the best we +can do. The default is to wait until mount(8) returns without intervention.") + + (umount-wait + (integer 12) + "Set the default time to wait for a response from a spawned umount(8) +before sending it a SIGTERM. Note that we still need to wait for the RPC layer +to timeout before the sub-process exits so this isn't ideal but it is the best +we can do.") + + (browse-mode? + (boolean #t) + "Should maps be browsable by default?") + + (mount-nfs-default-protocol + (integer 3) + "Set the default protocol that mount.nfs(8) uses when performing a mount. +Autofs needs to know the default NFS protocol that mount.nfs(8) uses so it can +do special case handling for its availability probe for different NFS +protocols. Since we can't identify this default automatically we need to set +it in the autofs configuration.") + + (append-options? + (boolean #t) + "When #t, global options are appended to map entry options. When #f, map +entry options replace the global options.") + + (logging + (log-level #:none) + "Default log level. May be #:none, #:verbose, or #:debug.") + + (force-standard-program-map-env? + (boolean #f) + "Override the use of a prefix with standard environment variables when a +program map is executed. Since program maps are run as the privileged user +setting these standard environment variables opens automount(8) to potential +user privilege escalation when the program map is written in a language that +can load components from, for example, a user home directory.") + + (map-hash-table-size + (integer 1024) + "This configuration option may be used to change the number of hash table +slots. + +This configuration option affects the overhead of searching the map entry +cache for map entries when there are a large number of entries. It affects +the number of entries that must be looked at to locate a map entry in the map +entry cache. For example, the default of 1024 and a direct map with 8000 +entries would result in each slot containing an average of 8 entries, which +should be acceptable. + +However, if excessive CPU usage is observed during automount lookups +increasing this option can reduce the CPU overhead considerably because it +reduces the length of the search chains. + +Note that the number of entries in a map doesn't necessarily relate to the +number of entries used in the map entry cache. + +There are two distinct cases where the map hash table can make a significant +difference, direct maps and indirect maps that use the \"browse\" option. + +For indirect maps that do not use the \"browse\" option entries are added to +the map entry cache at lookup so the number of active cache entries, in this +case, is usually much less than the number of entries in the map. In this +last case it would be unusual for the map entry cache to grow large enough to +warrant increasing the default before an event that cleans stale entries, a +map re-read for example.") + + (use-hostname-for-mounts? + (boolean #f) + "NFS mounts where the host name resolves to more than one IP address are +probed for availability and to establish the order in which mounts to them +should be tried. To ensure that mount attempts are made only to hosts that +are responding and are tried in the order of hosts with the quickest response +the IP address of the host needs to be used for the mount. + +If it is necessary to use the hostname given in the map entry for the mount +regardless, then set this option to #t. + +Be aware that if this is done there is no defense against the host name +resolving to one that isn't responding and while the number of attempts at a +successful mount will correspond to the number of addresses the host name +resolves to the order will also not correspond to fastest responding hosts.") + + (disable-not-found-message? + (boolean #f) + "The original request to add this log message needed it to be +unconditional. That produces, IMHO, unnecessary noise in the log so a +configuration option has been added to provide the ability to turn it off.") + + (use-ignore-mount-option? + (boolean #f) + "An option to enable the use of autofs pseudo option \"disable\". This +option is used as a hint to user space that the mount entry should be omitted +from mount table listings. The default is #f to avoid unexpected changes in +behaviour and so is an opt-in setting.") + + (sss-master-map-wait + (integer 0) + "Set the time to wait and retry if sssd is unable to read the master map at +program start. Default is 0 (don't wait) or 10 if sss supports returning +EHSTDOWN when the provider isn't available. + +If the sss library upports returning EHOSTDOWN when the provider is down then +this value is how long to wait between re‐ tries reading the master map. When +reading dependent maps or looking up a map key this value is multiplied by the +number of retries that would be used when reading the master map.") + + (use-mount-request-log-id? + (boolean #f) + "Set whether to use a mount request log id so that log entries for specific +mount requests can be easily identified in logs that have multiple concurrent +requests.") + (prefix autofs-)) + +(define (indirect-map->file-name indirect-map) + (string-append + (string-replace-substring + (substring (autofs-indirect-map-mount-point indirect-map) 1) + "/" "-") ".map")) + +(define (autofs-build-config config) + (let* ((mounts (autofs-configuration-mounts config)) + (autofs-conf (list-transduce (base-transducer config) rcons + autofs-configuration-fields)) + ;; List of serialized direct maps. + (direct-maps + (serialize-autofs-map-entries + #f (filter autofs-direct-map? mounts))) + + ;; List of (file-name mount-point serialized-map). + (indirect-maps + (map + (lambda (indirect-map) + (list (indirect-map->file-name indirect-map) + (autofs-indirect-map-mount-point indirect-map) + (autofs-serialize-indirect-map #f indirect-map))) + (filter autofs-indirect-map? mounts)))) + (computed-file + "autofs-config" + (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 "/autofs.conf") + (lambda (autofs-conf) + ;; Write out the serialized config. + (display (string-join + (cons* + "[ autofs ]" + (string-append "master_map_name = " + #$output "/auto.master") + '#$autofs-conf) + "\n" 'suffix) + autofs-conf))) + + ;; Write out the master map. + (call-with-output-file (string-append #$output "/auto.master") + (lambda (master-map) + ;; Write the direct entries to the master map. + (display '#$direct-maps master-map) + + ;; Write indirect maps to their own files. + (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* ((config-dir (autofs-build-config config)) + (autofs-conf (file-append config-dir "/autofs.conf")) + (conf-link "/etc/autofs.conf") + (no-mounts? (null? (autofs-configuration-mounts config))) + (direct-mount-points + (map + autofs-map-entry-mount-point + (filter autofs-direct-map? + (autofs-configuration-mounts config)))) + (indirect-mount-points + (map + autofs-indirect-map-mount-point + (filter + autofs-indirect-map? + (autofs-configuration-mounts config)))) + (mount-points (append direct-mount-points indirect-mount-points))) + #~(begin + (use-modules (guix build utils)) + (for-each mkdir-p (cons "/var/lib/nfs/sm" '#$mount-points)) + (when (or (false-if-exception (lstat #$conf-link)) + (stat #$conf-link #f)) + (delete-file #$conf-link)) + (unless #$no-mounts? + (symlink #$autofs-conf #$conf-link))))) + +(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 to the service +requirements. + +If @var{config} contains SMB mounts, adds samba-nmbd and samba-winbindd to the +service requirements. +" + (delete-duplicates + (fold + (lambda (fs-type acc) + (cond + ((string= "nfs" fs-type) + (append acc '(rpc.statd))) + ((string= "smb" fs-type) + (append acc '(samba-nmbd samba-winbindd))))) + '() + (map autofs-map-entry-type (autofs-configuration->raw-entries config))))) + +(define (autofs-shepherd-service config) + (match-record config (autofs timeout) + (begin + (define autofs-command + ;; Autofs doesn't let us specify the config file, so we rely on + ;; autofs-activation linking /etc/autofs.conf to the store. + #~(list + #$(file-append autofs "/sbin/automount") + "-f" + "-t" (number->string #$timeout) + "-p" #$%autofs-pid-file)) + + (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 (autofs-configuration-merge a b) + (autofs-configuration + (inherit b) + (mounts (append (autofs-configuration-mounts a) + (autofs-configuration-mounts b))))) + +(define-public autofs-service-type + (service-type + (name 'autofs) + (description "Run autofs") + (extensions + (list + (service-extension activation-service-type + autofs-activation) + (service-extension shepherd-root-service-type + autofs-shepherd-service))) + (compose + (cut reduce autofs-configuration-merge (autofs-configuration) <>)) + (default-value (autofs-configuration))))