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