unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
blob 7a92a2b9d59bb58cfb95592fc61f0fcefe522658 6366 bytes (raw)
name: gnu/services/file-systems.scm 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
 
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services file-systems)
  #:use-module (gnu packages file-systems)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:export (zfs-service-type
            zfs-configuration
            zfs-configuration?))

(define-record-type* <zfs-configuration>
  zfs-configuration make-zfs-configuration zfs-configuration?
  ; kernel you want to compile the base-zfs module for.
  (kernel     zfs-configuration-kernel)
  ; base package that will be compiled for the kernel
  (base-zfs   zfs-configuration-base-zfs  (default zfs))
  ; list of string options.
  (options    zfs-configuration-options   (default '())))

(define (make-zfs-package conf)
  (let ((base-zfs (zfs-configuration-base-zfs conf))
        (kernel   (zfs-configuration-kernel conf)))
    (package
      (inherit base-zfs)
      (name (string-join (list (package-name base-zfs)
                               "for"
                               (package-name kernel)
                               (package-version kernel)
                               "version")
                         "-"))
      (arguments (cons* #:linux kernel (package-arguments base-zfs))))))

(define (zfs-loadable-module conf)
  (list (list (make-zfs-package conf) "module")))

(define (zfs-shepherd-services conf)
  (let* ((zfs-package (make-zfs-package conf))
         (zpool       (file-append zfs-package "/sbin/zpool")))
    (list
      (shepherd-service
        (documentation "Scans for ZFS pools and automounts filesystems.")
        (provision '(zfs-scan-automount))
        (requirement '(root-file-system))
        (modules `((srfi srfi-1)
                   (srfi srfi-34)
                   (srfi srfi-35)
                   (rnrs io ports)
                   ,@%default-modules))
        (start #~(lambda _
                   (and
                     ;; You'd think we could've used kernel-module-loader-service-type,
                     ;; but the kernel-module-loader shepherd service is dependent on
                     ;; file-systems, and file-systems is made dependent on this
                     ;; service. And we need the kernel module to be loaded before we
                     ;; scan for ZFS pools. So break the dependency loop by just
                     ;; loading ZFS module here by ourselves.
                     (or (file-exists? "/proc/sys/kernel/modprobe")
                         (begin
                           (format (current-error-port) "error loading 'zfs' module: ~a~%"
                                   "Kernel is missing loadable module support.")
                           #f))
                     (guard (c ((message-condition? c)
                                (format (current-error-port)
                                        "error loading 'zfs' module: ~a~%"
                                        (condition-message c))
                                #f))
                       (let ((modprobe (call-with-input-file "/proc/sys/kernel/modprobe"
                                                             get-line)))
                         (invoke/quiet modprobe "--" "zfs")))

                     ; scan for pools and automount contained datasets.
                     (guard (c ((message-condition? c)
                                (format (current-error-port)
                                        "error importing zpools: ~a~%"
                                        (condition-message?))
                                #f))
                       ;; (current-output-port) is typically connected to /dev/klog,
                       ;; so redirect it to (current-error-port) so that user can see
                       ;; prompts for passphrases on console
                       (with-output-to-port (current-error-port)
                         (lambda ()
                           (invoke #$zpool "import" "-a" "-l")))))))
        (stop #~(const #t))))))

(define (zfs-profile-service conf)
  (list (make-zfs-package conf)))

(define (zfs-etc-service conf)
  (let ((options (zfs-configuration-options conf)))
    (if (null? options)
        '()
        `(("modprobe.d/zfs.conf"
           ,(plain-file "zfs.conf"
                        (string-join (cons "options zfs" options) " ")))))))

(define zfs-service-type
  (service-type (name 'zfs)
                (extensions
                  (list
                    ; install the kernel module
                    (service-extension kernel-loadable-module-service-type
                                       zfs-loadable-module)
                    ; load ZFS module, scan ZFS pools, and automount filesystems
                    (service-extension shepherd-root-service-type
                                       zfs-shepherd-services)
                    ; make sure automount occurs before file-systems target is reached
                    (service-extension file-systems-target-service-type
                                       (const '(zfs-scan-automount)))
                    ; install ZFS management tools
                    (service-extension profile-service-type
                                       zfs-profile-service)
                    ; install ZFS module options
                    (service-extension etc-service-type
                                       zfs-etc-service)))
                (description
                  "Install ZFS, an advanced filesystem and volume manager.")))

debug log:

solving 7a92a2b9d5 ...
found 7a92a2b9d5 in https://yhetil.org/guix-patches/6wemXB-PfHUqbuVr5-XRf0-tY4cKGGtKiUqrZPrIZYXoBw17L3xRuZrGOJQfTo5PKfFNCM8KyRTllidoc7asPE2x98BTiJSPVR7OSjxCuw8=@protonmail.com/

applying [1/1] https://yhetil.org/guix-patches/6wemXB-PfHUqbuVr5-XRf0-tY4cKGGtKiUqrZPrIZYXoBw17L3xRuZrGOJQfTo5PKfFNCM8KyRTllidoc7asPE2x98BTiJSPVR7OSjxCuw8=@protonmail.com/
diff --git a/gnu/services/file-systems.scm b/gnu/services/file-systems.scm
new file mode 100644
index 0000000000..7a92a2b9d5

Checking patch gnu/services/file-systems.scm...
Applied patch gnu/services/file-systems.scm cleanly.

index at:
100644 7a92a2b9d59bb58cfb95592fc61f0fcefe522658	gnu/services/file-systems.scm

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).