gnu/system/file-systems.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu system file-systems)
  20   #:use-module (ice-9 match)
  21   #:use-module (guix records)
  22   #:use-module (guix store)
  23   #:use-module ((gnu build file-systems)
  24                 #:select (string->uuid uuid->string))
  25   #:re-export (string->uuid
  26                uuid->string)
  27   #:export (<file-system>
  28             file-system
  29             file-system?
  30             file-system-device
  31             file-system-title
  32             file-system-mount-point
  33             file-system-type
  34             file-system-needed-for-boot?
  35             file-system-flags
  36             file-system-options
  37             file-system-mount?
  38             file-system-check?
  39             file-system-create-mount-point?
  40             file-system-dependencies
  41
  42             file-system->spec
  43             specification->file-system-mapping
  44             uuid
  45
  46             %fuse-control-file-system
  47             %binary-format-file-system
  48             %shared-memory-file-system
  49             %pseudo-terminal-file-system
  50             %tty-gid
  51             %immutable-store
  52             %control-groups
  53             %elogind-file-systems
  54
  55             %base-file-systems
  56             %container-file-systems
  57
  58             <file-system-mapping>
  59             file-system-mapping
  60             file-system-mapping?
  61             file-system-mapping-source
  62             file-system-mapping-target
  63             file-system-mapping-writable?
  64
  65             %store-mapping))
  66
  67 ;;; Commentary:
  68 ;;;
  69 ;;; Declaring file systems to be mounted.
  70 ;;;
  71 ;;; Code:
  72
  73 ;; File system declaration.
  74 (define-record-type* <file-system> file-system
  75   make-file-system
  76   file-system?
  77   (device           file-system-device)           ; string
  78   (title            file-system-title             ; 'device | 'label | 'uuid
  79                     (default 'device))
  80   (mount-point      file-system-mount-point)      ; string
  81   (type             file-system-type)             ; string
  82   (flags            file-system-flags             ; list of symbols
  83                     (default '()))
  84   (options          file-system-options           ; string or #f
  85                     (default #f))
  86   (mount?           file-system-mount?            ; Boolean
  87                     (default #t))
  88   (needed-for-boot? %file-system-needed-for-boot? ; Boolean
  89                     (default #f))
  90   (check?           file-system-check?            ; Boolean
  91                     (default #t))
  92   (create-mount-point? file-system-create-mount-point? ; Boolean
  93                        (default #f))
  94   (dependencies     file-system-dependencies      ; list of <file-system>
  95                     (default '())))               ; or <mapped-device>
  96
  97 (define-inlinable (file-system-needed-for-boot? fs)
  98   "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
  99 file system."
 100   (or (%file-system-needed-for-boot? fs)
 101       (string=? "/" (file-system-mount-point fs))))
 102
 103 (define (file-system->spec fs)
 104   "Return a list corresponding to file-system FS that can be passed to the
 105 initrd code."
 106   (match fs
 107     (($ <file-system> device title mount-point type flags options _ _ check?)
 108      (list device title mount-point type flags options check?))))
 109
 110 (define (specification->file-system-mapping spec writable?)
 111   "Read the SPEC and return the corresponding <file-system-mapping>.  SPEC is
 112 a string of the form \"SOURCE\" or \"SOURCE=TARGET\".  The former specifies
 113 that SOURCE from the host should be mounted at SOURCE in the other system.
 114 The latter format specifies that SOURCE from the host should be mounted at
 115 TARGET in the other system."
 116   (let ((index (string-index spec #\=)))
 117     (if index
 118         (file-system-mapping
 119          (source (substring spec 0 index))
 120          (target (substring spec (+ 1 index)))
 121          (writable? writable?))
 122         (file-system-mapping
 123          (source spec)
 124          (target spec)
 125          (writable? writable?)))))
 126
 127 (define-syntax uuid
 128   (lambda (s)
 129     "Return the bytevector corresponding to the given UUID representation."
 130     (syntax-case s ()
 131       ((_ str)
 132        (string? (syntax->datum #'str))
 133        ;; A literal string: do the conversion at expansion time.
 134        (let ((bv (string->uuid (syntax->datum #'str))))
 135          (unless bv
 136            (syntax-violation 'uuid "invalid UUID" s))
 137          (datum->syntax #'str bv)))
 138       ((_ str)
 139        #'(string->uuid str)))))
 140
 141 \f
 142 ;;;
 143 ;;; Common file systems.
 144 ;;;
 145
 146 (define %fuse-control-file-system
 147   ;; Control file system for Linux' file systems in user-space (FUSE).
 148   (file-system
 149     (device "fusectl")
 150     (mount-point "/sys/fs/fuse/connections")
 151     (type "fusectl")
 152     (check? #f)))
 153
 154 (define %binary-format-file-system
 155   ;; Support for arbitrary executable binary format.
 156   (file-system
 157     (device "binfmt_misc")
 158     (mount-point "/proc/sys/fs/binfmt_misc")
 159     (type "binfmt_misc")
 160     (check? #f)))
 161
 162 (define %tty-gid
 163   ;; ID of the 'tty' group.  Allocate it statically to make it easy to refer
 164   ;; to it from here and from the 'tty' group definitions.
 165   996)
 166
 167 (define %pseudo-terminal-file-system
 168   ;; The pseudo-terminal file system.  It needs to be mounted so that
 169   ;; statfs(2) returns DEVPTS_SUPER_MAGIC like libc's getpt(3) expects (and
 170   ;; thus openpty(3) and its users, such as xterm.)
 171   (file-system
 172     (device "none")
 173     (mount-point "/dev/pts")
 174     (type "devpts")
 175     (check? #f)
 176     (needed-for-boot? #f)
 177     (create-mount-point? #t)
 178     (options (string-append "gid=" (number->string %tty-gid) ",mode=620"))))
 179
 180 (define %shared-memory-file-system
 181   ;; Shared memory.
 182   (file-system
 183     (device "tmpfs")
 184     (mount-point "/dev/shm")
 185     (type "tmpfs")
 186     (check? #f)
 187     (flags '(no-suid no-dev))
 188     (options "size=50%")                         ;TODO: make size configurable
 189     (create-mount-point? #t)))
 190
 191 (define %immutable-store
 192   ;; Read-only store to avoid users or daemons accidentally modifying it.
 193   ;; 'guix-daemon' has provisions to remount it read-write in its own name
 194   ;; space.
 195   (file-system
 196     (device (%store-prefix))
 197     (mount-point (%store-prefix))
 198     (type "none")
 199     (check? #f)
 200     (flags '(read-only bind-mount))))
 201
 202 (define %control-groups
 203   (let ((parent (file-system
 204                   (device "cgroup")
 205                   (mount-point "/sys/fs/cgroup")
 206                   (type "tmpfs")
 207                   (check? #f))))
 208     (cons parent
 209           (map (lambda (subsystem)
 210                  (file-system
 211                    (device "cgroup")
 212                    (mount-point (string-append "/sys/fs/cgroup/" subsystem))
 213                    (type "cgroup")
 214                    (check? #f)
 215                    (options subsystem)
 216                    (create-mount-point? #t)
 217
 218                    ;; This must be mounted after, and unmounted before the
 219                    ;; parent directory.
 220                    (dependencies (list parent))))
 221                '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer"
 222                  "blkio" "perf_event" "hugetlb")))))
 223
 224 (define %elogind-file-systems
 225   ;; We don't use systemd, but these file systems are needed for elogind,
 226   ;; which was extracted from systemd.
 227   (list (file-system
 228           (device "none")
 229           (mount-point "/run/systemd")
 230           (type "tmpfs")
 231           (check? #f)
 232           (flags '(no-suid no-dev no-exec))
 233           (options "mode=0755")
 234           (create-mount-point? #t))
 235         (file-system
 236           (device "none")
 237           (mount-point "/run/user")
 238           (type "tmpfs")
 239           (check? #f)
 240           (flags '(no-suid no-dev no-exec))
 241           (options "mode=0755")
 242           (create-mount-point? #t))
 243         ;; Elogind uses cgroups to organize processes, allowing it to map PIDs
 244         ;; to sessions.  Elogind's cgroup hierarchy isn't associated with any
 245         ;; resource controller ("subsystem").
 246         (file-system
 247           (device "cgroup")
 248           (mount-point "/sys/fs/cgroup/elogind")
 249           (type "cgroup")
 250           (check? #f)
 251           (options "none,name=elogind")
 252           (create-mount-point? #t)
 253           (dependencies (list (car %control-groups))))))
 254
 255 (define %base-file-systems
 256   ;; List of basic file systems to be mounted.  Note that /proc and /sys are
 257   ;; currently mounted by the initrd.
 258   (append (list %pseudo-terminal-file-system
 259                 %shared-memory-file-system
 260                 %immutable-store)
 261           %control-groups))
 262
 263 ;; File systems for Linux containers differ from %base-file-systems in that
 264 ;; they impose additional restrictions such as no-exec or need different
 265 ;; options to function properly.
 266 ;;
 267 ;; The file system flags and options conform to the libcontainer
 268 ;; specification:
 269 ;; https://github.com/docker/libcontainer/blob/master/SPEC.md#filesystem
 270 (define %container-file-systems
 271   (list
 272    ;; Pseudo-terminal file system.
 273    (file-system
 274      (device "none")
 275      (mount-point "/dev/pts")
 276      (type "devpts")
 277      (flags '(no-exec no-suid))
 278      (needed-for-boot? #t)
 279      (create-mount-point? #t)
 280      (check? #f)
 281      (options "newinstance,ptmxmode=0666,mode=620"))
 282    ;; Shared memory file system.
 283    (file-system
 284      (device "tmpfs")
 285      (mount-point "/dev/shm")
 286      (type "tmpfs")
 287      (flags '(no-exec no-suid no-dev))
 288      (options "mode=1777,size=65536k")
 289      (needed-for-boot? #t)
 290      (create-mount-point? #t)
 291      (check? #f))
 292    ;; Message queue file system.
 293    (file-system
 294      (device "mqueue")
 295      (mount-point "/dev/mqueue")
 296      (type "mqueue")
 297      (flags '(no-exec no-suid no-dev))
 298      (needed-for-boot? #t)
 299      (create-mount-point? #t)
 300      (check? #f))))
 301
 302 \f
 303 ;;;
 304 ;;; Shared file systems, for VMs/containers.
 305 ;;;
 306
 307 ;; Mapping of host file system SOURCE to mount point TARGET in the guest.
 308 (define-record-type* <file-system-mapping> file-system-mapping
 309   make-file-system-mapping
 310   file-system-mapping?
 311   (source    file-system-mapping-source)          ;string
 312   (target    file-system-mapping-target)          ;string
 313   (writable? file-system-mapping-writable?        ;Boolean
 314              (default #f)))
 315
 316 (define %store-mapping
 317   ;; Mapping of the host's store into the guest.
 318   (file-system-mapping
 319    (source (%store-prefix))
 320    (target (%store-prefix))
 321    (writable? #f)))
 322
 323 ;;; file-systems.scm ends here