Mirror of GNU Guix
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

427 lines
17 KiB

  1. ;;; GNU Guix --- Functional package management for GNU
  2. ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
  3. ;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
  4. ;;;
  5. ;;; This file is part of GNU Guix.
  6. ;;;
  7. ;;; GNU Guix is free software; you can redistribute it and/or modify it
  8. ;;; under the terms of the GNU General Public License as published by
  9. ;;; the Free Software Foundation; either version 3 of the License, or (at
  10. ;;; your option) any later version.
  11. ;;;
  12. ;;; GNU Guix is distributed in the hope that it will be useful, but
  13. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;;; GNU General Public License for more details.
  16. ;;;
  17. ;;; You should have received a copy of the GNU General Public License
  18. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
  19. (define-module (gnu services nfs)
  20. #:use-module (gnu)
  21. #:use-module (gnu services shepherd)
  22. #:use-module (gnu packages onc-rpc)
  23. #:use-module (gnu packages linux)
  24. #:use-module (gnu packages nfs)
  25. #:use-module (guix)
  26. #:use-module (guix records)
  27. #:use-module (srfi srfi-1)
  28. #:use-module (ice-9 match)
  29. #:use-module (gnu build file-systems)
  30. #:export (rpcbind-service-type
  31. rpcbind-configuration
  32. rpcbind-configuration?
  33. pipefs-service-type
  34. pipefs-configuration
  35. pipefs-configuration?
  36. idmap-service-type
  37. idmap-configuration
  38. idmap-configuration?
  39. gss-service-type
  40. gss-configuration
  41. gss-configuration?
  42. nfs-service-type
  43. nfs-configuration
  44. nfs-configuration?))
  45. (define default-pipefs-directory "/var/lib/nfs/rpc_pipefs")
  46. (define-record-type* <rpcbind-configuration>
  47. rpcbind-configuration make-rpcbind-configuration
  48. rpcbind-configuration?
  49. (rpcbind rpcbind-configuration-rpcbind
  50. (default rpcbind))
  51. (warm-start? rpcbind-configuration-warm-start?
  52. (default #t)))
  53. (define rpcbind-service-type
  54. (let ((proc
  55. (lambda (config)
  56. (define rpcbind
  57. (rpcbind-configuration-rpcbind config))
  58. (define rpcbind-command
  59. #~(list (string-append #$rpcbind "/bin/rpcbind") "-f"
  60. #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
  61. (shepherd-service
  62. (documentation "Start the RPC bind daemon.")
  63. (requirement '(networking))
  64. (provision '(rpcbind-daemon))
  65. (start #~(make-forkexec-constructor #$rpcbind-command))
  66. (stop #~(make-kill-destructor))))))
  67. (service-type
  68. (name 'rpcbind)
  69. (extensions
  70. (list (service-extension shepherd-root-service-type
  71. (compose list proc))))
  72. ;; We use the extensions feature to allow other services to automatically
  73. ;; configure and start this service. Only one value can be provided. We
  74. ;; override it with the value returned by the extending service.
  75. (compose identity)
  76. (extend (lambda (config values)
  77. (match values
  78. ((first . rest) first)
  79. (_ config))))
  80. (default-value (rpcbind-configuration)))))
  81. (define-record-type* <pipefs-configuration>
  82. pipefs-configuration make-pipefs-configuration
  83. pipefs-configuration?
  84. (mount-point pipefs-configuration-mount-point
  85. (default default-pipefs-directory)))
  86. (define pipefs-service-type
  87. (let ((proc
  88. (lambda (config)
  89. (define pipefs-directory (pipefs-configuration-mount-point config))
  90. (shepherd-service
  91. (documentation "Mount the pipefs pseudo file system.")
  92. (provision '(rpc-pipefs))
  93. (start #~(lambda ()
  94. (mkdir-p #$pipefs-directory)
  95. (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
  96. (member #$pipefs-directory (mount-points))))
  97. (stop #~(lambda (pid . args)
  98. (umount #$pipefs-directory MNT_DETACH)
  99. (not (member #$pipefs-directory (mount-points)))))))))
  100. (service-type
  101. (name 'pipefs)
  102. (extensions
  103. (list (service-extension shepherd-root-service-type
  104. (compose list proc))))
  105. ;; We use the extensions feature to allow other services to automatically
  106. ;; configure and start this service. Only one value can be provided. We
  107. ;; override it with the value returned by the extending service.
  108. (compose identity)
  109. (extend (lambda (config values) (first values)))
  110. (default-value (pipefs-configuration)))))
  111. (define-record-type* <gss-configuration>
  112. gss-configuration make-gss-configuration
  113. gss-configuration?
  114. (pipefs-directory gss-configuration-pipefs-directory
  115. (default default-pipefs-directory))
  116. (nfs-utils gss-configuration-gss
  117. (default nfs-utils)))
  118. (define gss-service-type
  119. (let ((proc
  120. (lambda (config)
  121. (define nfs-utils
  122. (gss-configuration-gss config))
  123. (define pipefs-directory
  124. (gss-configuration-pipefs-directory config))
  125. (define gss-command
  126. #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
  127. "-p" #$pipefs-directory))
  128. (shepherd-service
  129. (documentation "Start the RPC GSS daemon.")
  130. (requirement '(rpcbind-daemon rpc-pipefs))
  131. (provision '(gss-daemon))
  132. (start #~(make-forkexec-constructor #$gss-command))
  133. (stop #~(make-kill-destructor))))))
  134. (service-type
  135. (name 'gss)
  136. (extensions
  137. (list (service-extension shepherd-root-service-type
  138. (compose list proc))))
  139. ;; We use the extensions feature to allow other services to automatically
  140. ;; configure and start this service. Only one value can be provided. We
  141. ;; override it with the value returned by the extending service.
  142. (compose identity)
  143. (extend (lambda (config values)
  144. (match values
  145. ((first . rest) first)
  146. (_ config))))
  147. (default-value (gss-configuration)))))
  148. (define-record-type* <idmap-configuration>
  149. idmap-configuration make-idmap-configuration
  150. idmap-configuration?
  151. (pipefs-directory idmap-configuration-pipefs-directory
  152. (default default-pipefs-directory))
  153. (domain idmap-configuration-domain
  154. (default #f))
  155. (nfs-utils idmap-configuration-nfs-utils
  156. (default nfs-utils))
  157. (verbosity idmap-configuration-verbosity
  158. (default 0)))
  159. (define idmap-service-type
  160. (let ((proc
  161. (lambda (config)
  162. (define nfs-utils
  163. (idmap-configuration-nfs-utils config))
  164. (define pipefs-directory
  165. (idmap-configuration-pipefs-directory config))
  166. (define domain (idmap-configuration-domain config))
  167. (define (idmap-config-file config)
  168. (plain-file "idmapd.conf"
  169. (string-append
  170. "\n[General]\n"
  171. "Verbosity = "
  172. (number->string
  173. (idmap-configuration-verbosity config))
  174. "\n"
  175. (if domain
  176. (format #f "Domain = ~a\n" domain)
  177. "")
  178. "\n[Mapping]\n"
  179. "Nobody-User = nobody\n"
  180. "Nobody-Group = nogroup\n")))
  181. (define idmap-command
  182. #~(list (string-append #$nfs-utils "/sbin/rpc.idmapd") "-f"
  183. "-p" #$pipefs-directory
  184. ;; TODO: this is deprecated
  185. "-c" #$(idmap-config-file config)))
  186. (shepherd-service
  187. (documentation "Start the RPC IDMAP daemon.")
  188. (requirement '(rpcbind-daemon rpc-pipefs))
  189. (provision '(idmap-daemon))
  190. (start #~(make-forkexec-constructor #$idmap-command))
  191. (stop #~(make-kill-destructor))))))
  192. (service-type
  193. (name 'idmap)
  194. (extensions
  195. (list (service-extension shepherd-root-service-type
  196. (compose list proc))))
  197. ;; We use the extensions feature to allow other services to automatically
  198. ;; configure and start this service. Only one value can be provided. We
  199. ;; override it with the value returned by the extending service.
  200. (compose identity)
  201. (extend (lambda (config values) (first values)))
  202. (default-value (idmap-configuration)))))
  203. (define-record-type* <nfs-configuration>
  204. nfs-configuration make-nfs-configuration
  205. nfs-configuration?
  206. (nfs-utils nfs-configuration-nfs-utils
  207. (default nfs-utils))
  208. (nfs-versions nfs-configuration-nfs-versions
  209. (default '("4.2" "4.1" "4.0")))
  210. (exports nfs-configuration-exports
  211. (default '()))
  212. (rpcmountd-port nfs-configuration-rpcmountd-port
  213. (default #f))
  214. (rpcstatd-port nfs-configuration-rpcstatd-port
  215. (default #f))
  216. (rpcbind nfs-configuration-rpcbind
  217. (default rpcbind))
  218. (idmap-domain nfs-configuration-idmap-domain
  219. (default "localdomain"))
  220. (nfsd-port nfs-configuration-nfsd-port
  221. (default 2049))
  222. (nfsd-threads nfs-configuration-nfsd-threads
  223. (default 8))
  224. (pipefs-directory nfs-configuration-pipefs-directory
  225. (default default-pipefs-directory))
  226. ;; List of modules to debug; any of nfsd, nfs, rpc, idmap, statd, or mountd.
  227. (debug nfs-configuration-debug
  228. (default '())))
  229. (define (nfs-shepherd-services config)
  230. "Return a list of <shepherd-service> for the NFS daemons with CONFIG."
  231. (match-record config <nfs-configuration>
  232. (nfs-utils nfs-versions exports
  233. rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
  234. pipefs-directory debug)
  235. (list (shepherd-service
  236. (documentation "Mount the nfsd pseudo file system.")
  237. (provision '(/proc/fs/nfsd))
  238. (start #~(lambda ()
  239. (mount "nfsd" "/proc/fs/nfsd" "nfsd")
  240. (member "/proc/fs/nfsd" (mount-points))))
  241. (stop #~(lambda (pid . args)
  242. (umount "/proc/fs/nfsd" MNT_DETACH)
  243. (not (member "/proc/fs/nfsd" (mount-points))))))
  244. (shepherd-service
  245. (documentation "Run the NFS statd daemon.")
  246. (provision '(rpc.statd))
  247. (requirement '(/proc/fs/nfsd rpcbind-daemon))
  248. (start
  249. #~(make-forkexec-constructor
  250. (list #$(file-append nfs-utils "/sbin/rpc.statd")
  251. ;; TODO: notification support may require a little more
  252. ;; configuration work.
  253. "--no-notify"
  254. #$@(if (member 'statd debug)
  255. '("--no-syslog") ; verbose logging to stderr
  256. '())
  257. "--foreground"
  258. #$@(if rpcstatd-port
  259. '("--port" (number->string rpcstatd-port))
  260. '()))
  261. #:pid-file "/var/run/rpc.statd.pid"))
  262. (stop #~(make-kill-destructor)))
  263. (shepherd-service
  264. (documentation "Run the NFS mountd daemon.")
  265. (provision '(rpc.mountd))
  266. (requirement '(/proc/fs/nfsd rpc.statd))
  267. (start
  268. #~(make-forkexec-constructor
  269. (list #$(file-append nfs-utils "/sbin/rpc.mountd")
  270. "--foreground"
  271. #$@(if (member 'mountd debug)
  272. '("--debug" "all")
  273. '())
  274. #$@(if rpcmountd-port
  275. '("--port" (number->string rpcmountd-port))
  276. '()))))
  277. (stop #~(make-kill-destructor)))
  278. (shepherd-service
  279. (documentation "Run the NFS daemon.")
  280. (provision '(rpc.nfsd))
  281. (requirement '(/proc/fs/nfsd rpc.statd networking))
  282. (start
  283. #~(lambda _
  284. (zero? (apply system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
  285. (list
  286. #$@(if (member 'nfsd debug)
  287. '("--debug")
  288. '())
  289. "--port" #$(number->string nfsd-port)
  290. #$@(map (lambda (version)
  291. (string-append "--nfs-version=" version))
  292. nfs-versions)
  293. #$(number->string nfsd-threads))))))
  294. (stop
  295. #~(lambda _
  296. (zero?
  297. (system* #$(file-append nfs-utils "/sbin/rpc.nfsd") "0")))))
  298. (shepherd-service
  299. (documentation "Run the NFS mountd daemon and refresh exports.")
  300. (provision '(nfs))
  301. (requirement '(/proc/fs/nfsd rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
  302. (start
  303. #~(lambda _
  304. (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
  305. (cond
  306. ((member 'nfsd '#$debug)
  307. (system* rpcdebug "-m" "nfsd" "-s" "all"))
  308. ((member 'nfs '#$debug)
  309. (system* rpcdebug "-m" "nfs" "-s" "all"))
  310. ((member 'rpc '#$debug)
  311. (system* rpcdebug "-m" "rpc" "-s" "all"))))
  312. (zero? (system*
  313. #$(file-append nfs-utils "/sbin/exportfs")
  314. "-r" ; re-export
  315. "-a" ; everthing
  316. "-v" ; be verbose
  317. "-d" "all" ; debug
  318. ))))
  319. (stop
  320. #~(lambda _
  321. (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
  322. (cond
  323. ((member 'nfsd '#$debug)
  324. (system* rpcdebug "-m" "nfsd" "-c" "all"))
  325. ((member 'nfs '#$debug)
  326. (system* rpcdebug "-m" "nfs" "-c" "all"))
  327. ((member 'rpc '#$debug)
  328. (system* rpcdebug "-m" "rpc" "-c" "all"))))
  329. #t))
  330. (respawn? #f)))))
  331. (define %nfs-activation
  332. (with-imported-modules '((guix build utils))
  333. #~(begin
  334. (use-modules (guix build utils))
  335. ;; directory containing monitor list
  336. (mkdir-p "/var/lib/nfs/sm")
  337. ;; Needed for client recovery tracking
  338. (mkdir-p "/var/lib/nfs/v4recovery")
  339. (let ((user (getpw "nobody")))
  340. (chown "/var/lib/nfs"
  341. (passwd:uid user)
  342. (passwd:gid user))
  343. (chown "/var/lib/nfs/v4recovery"
  344. (passwd:uid user)
  345. (passwd:gid user)))
  346. #t)))
  347. (define nfs-service-type
  348. (service-type
  349. (name 'nfs)
  350. (extensions
  351. (list
  352. (service-extension shepherd-root-service-type nfs-shepherd-services)
  353. (service-extension activation-service-type (const %nfs-activation))
  354. (service-extension etc-service-type
  355. (lambda (config)
  356. `(("exports"
  357. ,(plain-file "exports"
  358. (string-join
  359. (map string-join
  360. (nfs-configuration-exports config))
  361. "\n"))))))
  362. ;; The NFS service depends on these other services. They are extended so
  363. ;; that users don't need to configure them manually.
  364. (service-extension idmap-service-type
  365. (lambda (config)
  366. (idmap-configuration
  367. (domain (nfs-configuration-idmap-domain config))
  368. (verbosity
  369. (if (member 'idmap (nfs-configuration-debug config))
  370. 10 0))
  371. (pipefs-directory (nfs-configuration-pipefs-directory config))
  372. (nfs-utils (nfs-configuration-nfs-utils config)))))
  373. (service-extension pipefs-service-type
  374. (lambda (config)
  375. (pipefs-configuration
  376. (mount-point (nfs-configuration-pipefs-directory config)))))
  377. (service-extension rpcbind-service-type
  378. (lambda (config)
  379. (rpcbind-configuration
  380. (rpcbind (nfs-configuration-rpcbind config)))))))
  381. (description
  382. "Run all NFS daemons and refresh the list of exported file systems.")))