@@ 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
@@ 1,7 1,8 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016 John Darrington <jmd@gnu.org>
+;;; Copyright © 2016, 2025 John Darrington <jmd@gnu.org>
;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim@guixotic.coop>
+;;; Copyright © 2023-2025 Ian Eure <ian@retrospec.tv>
;;;
;;; This file is part of GNU Guix.
;;;
@@ 19,16 20,22 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(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-configuration> (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))))